home *** CD-ROM | disk | FTP | other *** search
/ Acorn RISC PD-CD 1 / Acorn RISC PD-CD 1.iso / utilities / powerbase / _powerbase / _runimage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-02-01  |  229.2 KB  |  10,513 lines
  1.  ><PBase$Dir>.!RunImage
  2.  !RunImage for !Powerbase database
  3.  D.L. & S.R. Haslam
  4.  Heap Manager (module + BASIC)
  5.  S.R. Haslam
  6.  Interface Manager (v.2)
  7.  Simon Huntingdon
  8. "version$="4.993 (01-Feb-1994)"
  9. ,intversion$="Interface Manager (v.2.00)"
  10.  "OS_Byte",202,0,255 
  11.  ,kbdstatus%
  12.  fatal_err%=255:moan_err%=254
  13. present%=
  14. ,"L0 error: "+
  15. $+" during initialisation at line "+
  16. setup
  17.  buff%>endbuff% 
  18.  0,"No room for defs."
  19.  menu_ptr%>men_end% 
  20.  0,"No room for menus"
  21. wimp_error(
  22.  "OS_GetEnv" 
  23.  ComString$
  24. ComString$,"-database") 
  25. 4  File$=
  26. ComString$,
  27. ComString$,"-database")+10)
  28.  "OS_GSTrans",File$,
  29. 13),255 
  30.  ,File$,L%
  31.   File$=
  32. File$,L%)
  33. get_it_in(File$)
  34. wimp_error(
  35.  quit%
  36. close_down
  37.  "OS_Byte",229,1:
  38.  "OS_Byte",124
  39.  "Wimp_Poll",mask%,block% 
  40.  reason%
  41.  "Interface_Poll",reason%,,mytask%
  42.  reason% 
  43.  autosave%>0 
  44.  Access%=
  45. check_save(saveint%*6000)
  46.  Imp_wait% 
  47.  merging% 
  48. ready_to_merge
  49.  flash%>0 
  50. flash(mainW%,field%(flash%))
  51. redraw(!block%)
  52.  "Wimp_OpenWindow",,block%
  53. perform_close(!block%)
  54. hourglass(
  55. hourglass(
  56. mouse(block%!0,block%!4,block%!8,block%!12,block%!16)
  57. end_drag(Start%,End%)
  58. process_key
  59. menu_select
  60. set_keyboard(!block%,block%!4)
  61.  17,18:
  62.  "Impulse_Decode",reason%,block%,,,,methodtable%,mytask% 
  63.  reason%,,,,,token%,params%,object%
  64.  reason%>=&200 
  65.  reason% 
  66. ;M      
  67.  &200,&201:
  68.  token%<>-1 
  69. Impulse_command(token%,params%,object%)
  70. </      
  71.  &202:
  72. Impulse_reply(token%,params%)
  73. =.      
  74.  &203:
  75. Impulse_send(token%,object%)
  76. >9      
  77.  &204:
  78. Impulse_receive(token%,params%,object%)
  79. ?        
  80. message
  81. not_acknowledged
  82. hourglass(on%)
  83.  (indexing% 
  84.  printing%) 
  85.  !block%=keypadW% 
  86.  on% 
  87.  "Hourglass_On" 
  88.  "Hourglass_Off"
  89. flash(wi%,ic%)
  90.  time%
  91.  "OS_ReadMonotonicTime" 
  92.  time%
  93.  (time% 
  94.  50)=0 
  95. invert(wi%,ic%)
  96.  Shutdown routines ---------------------------------------------------
  97. close_down
  98. :$block%="TASK":
  99.  "Wimp_CloseDown",mytask%,!block%:
  100.  "Interface_CloseDown",mytask%,!block%:
  101. ,"L0 error: "+
  102. $+" during closedown at line "+
  103.  "Hourglass_Smash"
  104.  "Interface_CloseDown",mytask%
  105.  "Impulse_CloseDown",mytask%
  106. $block%="TASK"
  107.  "Wimp_CloseDown",mytask%,!block%
  108.  "OS_Byte",202,kbdstatus%
  109.  "Hourglass_Smash"
  110.  warn% 
  111.  ram% 
  112. confirm("Closing down "+$database%+" on RAM disc. Changes not copied to permanent storage.") 
  113.  design% 
  114. save_form($database%+".Form")
  115.  present%=7 
  116. check_change
  117.  link$(0)="LOADED" 
  118.   lk=
  119. ($database%+".Link")
  120.  F%=1 
  121.  fields%
  122. #lk,link$(F%)
  123.  calc$(0)="LOADED" 
  124.   cl=
  125. ($database%+".Calc")
  126.  F%=1 
  127.  fields%
  128. #cl,calc$(F%)
  129.  menu%(5)>0 
  130.  menu_ptr%=menu%(5):menu%(5)=0
  131.  ###  Menu 5 is the menu of validation tables ###
  132.  Access%=
  133.  present%=7 
  134. mouse(0,0,4,keypadW%,19)
  135. close_log
  136. close_files
  137. hide_windows
  138. delete_icons(mainW%,0)
  139. delete_icons(datadicW%,0)
  140. delete_icons(pselectW%,1)
  141. delete_icons(keypadW%,37)
  142. recover_memory
  143. init_vars
  144.  I%=0 
  145.  MaxTabs%
  146.   printrel$(I%)=""
  147. field$()=""
  148. $Password%=""
  149. present%=
  150. exit%=
  151. lit(menu%(0),1,
  152. lit(menu%(0),2,
  153. lit(menu%(0),3,
  154. lit(menu%(2),1,
  155. ):ptr%=menu%(2)+52:ptr%!4=-1
  156. lit(menu%(6),6,
  157. lit(menu%(6),7,
  158. lit(menu%(6),8,
  159. set_auto(
  160. set_autobalance(
  161. tick(menu%(2),3,
  162. tick(menu%(2),4,
  163. $dbase%="No data"
  164. $database%="No data"
  165. redraw_icon(-2,pbaseicon%)
  166. delete_icons(wi%,ic%)
  167. !block%=wi%:block%!4=ic%
  168.  "Wimp_DeleteIcon",,block%
  169.   ic%+=1:block%!4=ic%
  170.  "Wimp_GetIconState",,block%
  171.  ((block%!24) 
  172.  (1<<23))>0
  173. close_files
  174.  key%
  175.  key%=0 
  176.  Keys%
  177. date(key%)
  178.  key%
  179. close_file(lk):link$()=""
  180. close_file(cl):calc$()=""
  181. close_file(dbasehandle%)
  182. close_file(csvhandle%)
  183. close_file(texthandle%)
  184. close_file(text%)
  185. close_file(toobighandle%)
  186. close_file(F)
  187. close_file(FH%)
  188. close_file(V)
  189. close_file(
  190.  filehandle%)
  191.  filehandle%>0 
  192. #filehandle%
  193.   filehandle%=0
  194. recover_memory
  195. scrap_sliding_block(headanchor%)
  196. scrap_sliding_block(undoanchor%)
  197. scrap_sliding_block(lineanchor%)
  198. scrap_sliding_block(textanchor%)
  199. scrap_sliding_block(formanchor%)
  200. scrap_sliding_block(selanchor%)
  201. scrap_sliding_block(tempanchor%)
  202. scrap_sliding_block(balanchor%)
  203. scrap_sliding_block(flaganchor%)
  204. scrap_sliding_block(transanchor%)
  205. scrap_sliding_block(sprsanchor%)
  206. scrap_sliding_block(recanchor%)
  207. scrap_sliding_block(saveanchor%)
  208. scrap_sliding_block(logoanchor%)
  209.  I%=0 
  210.  MaxTabs%
  211. scrap_sliding_block(tabanchor%(I%))
  212.  I%=0 
  213.  MaxKeys%+1
  214. scrap_sliding_block(keyanchor%(I%))
  215.  I%=1 
  216.  fields%
  217.  chartype%(I%)=40 
  218. scrap_sliding_block(Rf%(I%))
  219.  Error handling ------------------------------------------------------
  220. wimp_error(return%,err%,erl%,err$)
  221.  type%,result%
  222. close_down:
  223. ,"L0 error: "+
  224. $+" during error handler at line "+
  225.  "Wimp_CommandWindow",-1
  226. *block%!8=0:block%!12=wi%:block%!16=ic%
  227.  "Interface_SlabButton",,block%
  228. block%!0=err%
  229.  return% 
  230.  err%<>fatal_err% 
  231.  err%=moan_err% 
  232. <      type%=&11:
  233.  OK button and no "Error from" in title
  234. )      type%=3:
  235.  OK and Cancel buttons
  236. A      err$+=" @ "+
  237. (erl%)+" (OK to continue, Cancel to quit)"
  238.    type%=2:
  239.  Cancel buttom
  240. ;   err$+=" @ "+
  241. (erl%)+" (Powerbase must quit at once)"
  242. $(block%+4)=err$+
  243.  "Wimp_ReportError",block%,type%,"Powerbase" 
  244.  ,result%
  245.  result=1 means OK selected, 2 means Cancel selected
  246.  result%=2 
  247. close_down
  248. softerror(E$,E%)
  249. $(block%+4)=
  250. msg(E%)+E$
  251. !block%=255
  252.  "Wimp_ReportError",block%,&11,"Report from Powerbase"
  253. msg(E%)
  254. errorblock%=errormsg%
  255.  E%>1
  256. $  errorblock%+=
  257. ($errorblock%)+1
  258.   E%-=1
  259. $errorblock%,4)
  260.  Program initialisation ----------------------------------------------
  261. setup
  262.  F,A%,I%,J%,V%,valid$
  263. ("<Pbase$Dir>.Resources.Config")
  264. MaxFields%=
  265.  MaxFields%>127 
  266.  fatal_err%,
  267. msg(61)
  268. MaxKeys%=
  269. MaxTabs%=
  270. #F)-1
  271. datesep$=
  272. #F,1)
  273. timesep$=
  274. #F,1)
  275. #F:P%=
  276. S$," "):kill%=
  277. S$,P%-1)="YES")
  278. #F:P%=
  279. S$," "):commoncase%=(
  280. S$,P%-1)="YES")
  281. #F:P%=
  282. S$," "):common%=(
  283. S$,P%-1)="YES")
  284. #F:P%=
  285. S$," "):leftmenu%=(
  286. S$,P%-1)="YES")
  287. #F:P%=
  288. S$," "):
  289. S$,P%-1)="YES" 
  290.  caps%=128 
  291.  caps%=16
  292. winback%=
  293. close_file(F)
  294. dim_arrays(MaxFields%,MaxKeys%,MaxTabs%)
  295. init_vars
  296.  ------------------ Initialise Wimp ----------------------------
  297. $block%="TASK"
  298. mask%=(1<<11)
  299.  "Wimp_Initialise",200,!block%,"Powerbase" 
  300.  version%,mytask%
  301.  version%>=316 
  302.  RISCOS3=
  303.  RISCOS3=
  304.  "Impulse_Initialise",003,mytask%,"Powerbase",-1
  305.  "Interface_Initialise",mytask%
  306. Mpbaseicon%=
  307. create_icon(-1,0,-16,144,110,&1700312B,"",dbase%,psprite%,10)
  308.  --------- Set up Heap Manager. Load error messages -----------
  309. initheaps(128,128)
  310.  "OS_File",5,"<PBase$Dir>.Resources.Messages" 
  311.  ,,,,len%
  312. 'errormsg%=
  313. create_fixed_block(len%)
  314.  "OS_File",255,"<PBase$Dir>.Resources.Messages",errormsg%
  315.  I%=0 
  316.  len%
  317.  errormsg%?I%=10 
  318.  errormsg%?I%=13
  319.  "OS_Byte",135 
  320. ,,mode%
  321.  mode% 
  322.  12,15,16,17,35,36:f$="Sprites"
  323. :f$="Sprites22"
  324.  "OS_File",5,"<PBase$Dir>.Resources."+f$ 
  325.  ,,,,len%
  326. )(sprites%=
  327. create_fixed_block(len%+4)
  328. !sprites%=len%+4
  329.  "OS_File",255,"<PBase$Dir>.Resources."+f$,sprites%+4
  330. ,&undoanchor%=
  331. create_anchor("Undo")
  332. -)headanchor%=
  333. create_anchor("Heading")
  334. .*lineanchor%=
  335. create_anchor("TextLine")
  336. /&textanchor%=
  337. create_anchor("Text")
  338. 0&formanchor%=
  339. create_anchor("Form")
  340. 1.sprsanchor%=
  341. create_anchor("DbaseSprites")
  342. 2&tempanchor%=
  343. create_anchor("Temp")
  344. 3(balanchor%=
  345. create_anchor("Balance")
  346. 4'flaganchor%=
  347. create_anchor("Flags")
  348. 5/transanchor%=
  349. create_anchor("DataTransfer")
  350. 6)selanchor%=
  351. create_anchor("PrintSel")
  352. 7*recanchor%=
  353. create_anchor("RecordNum")
  354. 8,saveanchor%=
  355. create_anchor("SaveBuffer")
  356. 9&logoanchor%=
  357. create_anchor("Logo")
  358.  I%=0 
  359.  MaxKeys%+1
  360. ;3   keyanchor%(I%)=
  361. create_anchor("Key #"+
  362. (I%))
  363.  I%=0 
  364.  MaxTabs%
  365. >6   tabanchor%(I%)=
  366. create_anchor("VTable #"+
  367. (I%))
  368.  --------------- Read validation strings etc -----------------------
  369. ("<Pbase$Dir>.Resources.ValStrings")
  370. vstrings%=
  371.  vname$(vstrings%),valid%(vstrings%),rvalid%(vstrings%),hvalid%(vstrings%)
  372.  I%=0 
  373.  vstrings%
  374.   vname$(I%)=
  375. #V,4)
  376.   valid$=
  377. (valid$)+1:$V%=valid$:valid%(I%)=V%
  378. (valid$)+1:$V%=valid$:rvalid%(I%)=V%
  379. (valid$)+16:$V%=valid$+";Pptr_hand,12,8":hvalid%(I%)=V%
  380. close_file(V)
  381.  ---------------------------------------------------------------
  382.  Method structure
  383.  PASS=0 
  384. P%=methodtable%
  385.   [OPT PASS
  386.         equd    0
  387. R)        
  388. method(0,1,"GetPathname","")
  389. S'        
  390. method(0,2,"Selection","")
  391. T(        
  392. method(0,3,"ParseQuery","")
  393. U'        
  394. method(0,4,"GetRecord","")
  395. V'        
  396. method(0,5,"PutRecord","")
  397. W(        
  398. method(0,6,"ExpandCode","")
  399. X&        
  400. method(0,7,"GetField","")
  401. Y)        
  402. method(0,8,"GetExpanded","")
  403. Z         
  404. method(-1,-1,"","")
  405.  PASS
  406. getscreensize(ScreenWidth%,ScreenHeight%)
  407. create_windows
  408. make_menus
  409. set_auto(
  410. set_autobalance(
  411. get_choices("<Pbase$Dir>.Resources.Choices")
  412. method(Flags,Token,Method$,Syntax$)
  413. [OPT PASS
  414.         equd    Flags
  415.         equd    Token
  416. i         equs    Method$+
  417. j         equs    Syntax$+
  418.         align
  419. m    =PASS
  420. dim_arrays(F%,K%,T%)
  421.  desc%(F%),Tag$(F%),field%(F%),F$(F%),Rf%(F%),len%(F%),maxlen%(F%),chartype%(F%),fix%(F%),link$(F%),calc$(F%),Tab%(F%),field$(F%),update$(F%)
  422.  Date%(5),Index$(K%+1),KL%(K%+1),KF%(K%+1,1),KW%(K%+1,3),key$(K%+1),case%(K%+1),WD%(3),Ext%(10)
  423.  Label$(10,2)
  424.  Sum(30,3)
  425.  key 256,date% 6,calcrow% F%
  426.  menu%(22),choice$(4)
  427.  table$(T%+1),tabfieldlen%(9),fcol%(6),ncol%(6)
  428.  rel%(6)
  429.  buttonfield%(22)
  430. MC%=30:
  431.  L%(MC%)
  432.  -------------------- Allocate buffers ------------------------------
  433. {(indirectionmem%=&7000:menumem%=&1400
  434.  Mi% 20,Mo% 20
  435.  block% &1000,savebuff% &100,choices% &100
  436.  buff% indirectionmem%:endbuff%=buff%+indirectionmem%
  437.  menblk% menumem%:men_end%=menblk%+menumem%:menu_ptr%=menblk%
  438.  fieldmenu% 3200
  439.  hand% 16:$hand%="Pptr_hand,12,8"
  440.  paint% 8:$paint%="file_ff9"
  441.  writep% 16:$writep%="Pptr_write,4,4"
  442.  tick% 12:$tick%="Snull,yes"
  443.  dbase% 10:$dbase%="No data"
  444.  psprite% 15:$psprite%="S!Powerbase"
  445.  menspr% 15,mentxt% 1:$menspr%="Smenu;Z0":$mentxt%=""
  446.  winspr% 15,wintxt% 1:$winspr%="Swindow;Z0":$wintxt%=""
  447.  methodtable% 256
  448.  ------------- Indirection addresses for Heap Manager ---------------
  449.  keyanchor%(K%+1)
  450.  tabanchor%(T%)
  451.  printrel$(T%)
  452.  box% 16,box2% 16,matrix% 16,origin% 8
  453. init_vars
  454. $getrec%=213:ClientSearch$="TRUE"
  455. >Imp_wait%=
  456. :Impref%=0:merging%=
  457. :mergenum%=0:mergewith$=""
  458. -mergetag%=214:transtag%=215:printtag%=216
  459. ,flash%=
  460. :dup%=
  461. :filter%=
  462. :logosloaded%=
  463. 'accessbutton%=0:stop%=
  464. :scripton%=
  465. %displayed%=
  466. :scratchpad$="":k$=""
  467. ?Search$="TRUE":Filter$="TRUE":REC%=-1:usekey%=-1:useval$=""
  468. _real$="":visible$="":reform$="":val$="":calcfield%=0:savefunc$="":savetofile%=
  469. :startlog%=
  470. /password$="":myref%=-1:Type%=0:fieldtype%=1
  471. 4printing%=
  472. :indexing%=
  473. :validate%=
  474. :relations%=
  475. ;delwarn%=
  476. :autosave%=
  477. :export%=
  478. :csvconv%=
  479. :saveint%=10
  480. &autobalance%=0:balint%=25:added%=0
  481. .present%=0:fields%=0:template%=0:adjust%=
  482. (Listed%=
  483. :writingcsv%=
  484. :calcerror%=
  485. tlk=0:cl=0:V=0:F=0:FH%=0:dbasehandle%=0:csvhandle%=0:texthandle%=0:text%=0:toobighandle%=0:loghandle%=0:handle%=0
  486. $date%=
  487. "movetype%=8:movetype$="Move 
  488. hquit%=
  489. :exit%=
  490. :matching%=
  491. :newrec%=
  492. :val%=
  493. :ram%=
  494. :Access%=
  495. :Modify%=
  496. :warn%=
  497. :design%=
  498. :newtree%=
  499. /LenLine%=0:Count%=0:Start%=0:End%=0:Fptr%=0
  500. 4Fieldnumber%=0:calclink%=0:Keyfld0%=0:Keyfld1%=0
  501. BLastTable%=-1:Tablenumber%=-1:TabsLoaded$="Tables":table$()=""
  502. 5Rows%=0:TabFields%=0:Rec%=0:Match_tag%=1:fast%=10
  503. GKeys%=0:keylimit%=1:keylen%=1:LH%=90:file%=0:key%=0:top=8*file%+LH%
  504. +keyfunc$="":fieldfunc$="":Keys%=0:RU%=0
  505. 1printorder$="":Form$="":ImpCom$="":margin$=""
  506. uon$=
  507. (27)+
  508. (%10001000)
  509. 8Filename$="":extrakeys$="":extratabs$="":logpath$=""
  510. 2months$="JanFebMarAprMayJunJulAugSepOctNovDec"
  511.  Window handling -----------------------------------------------------
  512. create_windows
  513.  "Wimp_OpenTemplate",,"<Pbase$Dir>.Resources.Templates"
  514. 'infoW%=
  515. new_window("info",sprites%)
  516. text(infoW%,7)=version$
  517. text(infoW%,8)=intversion$
  518. <keypadW%=
  519. new_window("keypad",sprites%):Title%=block%!72
  520. zsavesubW%=
  521. new_window("savesub",sprites%):SubName%=
  522. text(savesubW%,3):SubSprite%=
  523. val(savesubW%,1):SubTitle%=block%!72
  524. UsaveW%=
  525. new_window("save",1):SaveName%=
  526. text(saveW%,0):SaveSprite%=
  527. val(saveW%,1)
  528. AdatadicW%=
  529. new_window("datadic",sprites%):TabTitle%=block%!72
  530. ^accessW%=
  531. new_window("access",sprites%):Password%=
  532. text(accessW%,0):AccessTitle%=block%!72
  533. qpassW%=
  534. new_window("password",sprites%):Read%=
  535. text(passW%,2):Write%=
  536. text(passW%,3):Manager%=
  537. text(passW%,5)
  538. :mainW%=
  539. new_window("main",sprites%):RecInfo%=block%!72
  540. ?keyW%=
  541. new_window("changekey",sprites%):KeyTitle%=block%!72
  542. 1F1dkey%=
  543. text(keyW%,0):F2dkey%=
  544. text(keyW%,1)
  545.  Wkey%(3)
  546.  word%=0 
  547. '  Wkey%(word%)=
  548. text(keyW%,word%+2)
  549.  word%
  550. KeyNo%=
  551. text(keyW%,6)
  552. BchangeW%=
  553. new_window("change",sprites%):ChangeTitle%=block%!72
  554. 'moveW%=
  555. new_window("move",sprites%)
  556. )tableW%=
  557. new_window("table",sprites%)
  558. linkW%=
  559. new_window("link",sprites%):LinkTitle%=block%!72:Tablename%=
  560. text(linkW%,0):fieldnum%=
  561. text(linkW%,2):expand%=
  562. text(linkW%,10)
  563. VmiscW%=
  564. new_window("misc",sprites%):database%=
  565. text(miscW%,1):$database%="No data"
  566.  ic%=2 
  567. $  Date%(ic%-2)=
  568. text(miscW%,ic%)
  569. Oused%=
  570. text(miscW%,17):filesize%=
  571. text(miscW%,18):percent%=
  572. text(miscW%,14)
  573. )printW%=
  574. new_window("print",sprites%)
  575. )matchW%=
  576. new_window("match",sprites%)
  577. 'listW%=
  578. new_window("list",sprites%)
  579. XcreateW%=
  580. new_window("create",sprites%):FtitleText%=block%!72:$FtitleText%="Field 0"
  581. DescText%=
  582. text(createW%,4):TagText%=
  583. text(createW%,5):LenText%=
  584. text(createW%,6):ValText%=
  585. text(createW%,28):InsText%=
  586. text(createW%,26):Fixpt%=
  587. text(createW%,13):$Fixpt%="2"
  588. ;mintext%=
  589. text(createW%,15):maxtext%=
  590. text(createW%,25)
  591. dboxX%=
  592. text(createW%,7):boxY%=
  593. text(createW%,8):boxW%=
  594. text(createW%,9):boxH%=
  595. text(createW%,10)
  596. ArelateW%=
  597. new_window("relation",sprites%):RelTitle%=block%!72
  598. @reformW%=
  599. new_window("reform",sprites%):RefmTitle%=block%!72
  600. &colW%=
  601. new_window("cols",sprites%)
  602. VcalcW%=
  603. new_window("calc",sprites%):CalcForm%=
  604. text(calcW%,0):CalcTitle%=block%!72
  605. )labelW%=
  606. new_window("label",sprites%)
  607. -pselectW%=
  608. new_window("pselect",sprites%)
  609. ?mergeW%=
  610. new_window("merge",sprites%):MergeTitle%=block%!72
  611. PsizeW%=
  612. new_window("size",sprites%):Records%=
  613. text(sizeW%,1):$Records%="100"
  614. .Increment%=
  615. text(sizeW%,3):$Increment%="0"
  616. =csvW%=
  617. new_window("csvfile",sprites%):CSVTitle%=block%!72
  618.  "Wimp_CloseTemplate"
  619.  common% 
  620. commonbuffers
  621. commonbuffers
  622. common(keypadW%,29,matchW%,0)
  623. common(moveW%,7,matchW%,0)
  624. common(changeW%,3,matchW%,0)
  625. common(savesubW%,0,matchW%,0)
  626. common(mergeW%,3,matchW%,0)
  627. common(wi%,ic%,wic%,icc%)
  628. Formula%=
  629. text(wic%,icc%)
  630. ;!block%=wi%:block%!4=ic%:
  631.  "Wimp_GetIconState",,block%
  632.  "Wimp_DeleteIcon",,block%
  633. #block%!28=Formula%:block%!4=wi%
  634.  "Wimp_CreateIcon",,block%+4 
  635.  handle%
  636. commoncase(wi%,ic%)
  637.  commoncase% 
  638. selected(wi%,ic%)
  639. set_icon(matchW%,16,on%)
  640. set_icon(keypadW%,32,on%)
  641. set_icon(moveW%,9,on%)
  642. set_icon(changeW%,5,on%)
  643. set_icon(savesubW%,5,on%)
  644. set_icon(mergeW%,12,on%)
  645. new_window(name$,sp%)
  646.  handle%
  647.  "Wimp_LoadTemplate",,block%,buff%,endbuff%,-1,name$,0 
  648.  ,,buff%
  649.  name$="main" 
  650.  block%?35=winback%
  651. block%!64=sp%
  652.  "Wimp_CreateWindow",,block% 
  653.  handle%
  654. =handle%
  655. show_windows
  656. open_window(mainW%)
  657.  (present% 
  658.  7)=7 
  659. selected(passW%,9) 
  660. 9    !block%=keypadW%:
  661.  "Wimp_GetWindowState",,block%
  662. 5    block%!12=block%!4+660:block%!8=block%!16-328
  663. ,    block%!20=0:block%!24=0:block%!28=-1
  664. $    
  665.  "Wimp_OpenWindow",,block%
  666.   addr=
  667. moveto(key%,top,1)
  668.  Listed% 
  669. open_window(listW%)
  670. open_window(whandle%)
  671. block%!0=whandle%
  672.  "Wimp_GetWindowState",,block%
  673. block%!28=-1
  674.  "Wimp_OpenWindow",,block%
  675. set_height(handle%,height%)
  676. 4!block%=handle%:
  677.  "Wimp_GetWindowState",,block%
  678. block%!16=block%!8+height%
  679.  "Wimp_OpenWindow",,block%
  680. perform_close(wi%)
  681.  wi% 
  682.  mainW%:
  683. close_window(keypadW%)
  684.  matchW%:matching%=
  685.  calcW%:calclink%=0
  686.  keyW%:
  687.   design%=
  688. :newtree%=
  689.   !block%=0:block%!4=-700
  690.   block%!8=506:block%!12=0
  691.  "Wimp_SetExtent",keyW%,block%
  692.   !block%=keyW%
  693.  mergeW%:
  694.  mergewith$<>"" 
  695.  "Impulse_SendMessage",&200,":"+mergewith$+"."+document$+" Edit On",,,,-1,mytask%
  696.   merging%=
  697. close_window(wi%)
  698. hide_windows
  699. perform_close(mainW%)
  700. perform_close(keypadW%)
  701. perform_close(datadicW%)
  702. perform_close(listW%)
  703. perform_close(matchW%)
  704. perform_close(relateW%)
  705. perform_close(keyW%)
  706. perform_close(reformW%)
  707. perform_close(calcW%)
  708. perform_close(mergeW%)
  709. perform_close(csvW%)
  710. close_window(whandle%)
  711. !block%=whandle%
  712.  "Wimp_CloseWindow",,block%
  713. redraw(handle%)
  714. (margin$)
  715. !block%=handle%
  716.  "Wimp_RedrawWindow",,block% 
  717.  more%
  718. get_origin(block%,x0%,y0%)
  719.  more%
  720. draw(x0%,y0%)
  721.  handle%<>datadicW% 
  722.  "Interface_Render3dWindow",,block%
  723.  "Wimp_GetRectangle",,block% 
  724.  more%
  725. get_origin(block%,
  726.  x0%,
  727.  y0%)
  728. x0%=block%!4-block%!20
  729. y0%=block%!16-block%!24
  730. draw(x0%,y0%)
  731.  TextPtr%,y1%,y2%,I%,chars%
  732.  handle% 
  733.  listW%
  734.   y1%=-(block%!40-y0%)
  735.   y2%=-(block%!32-y0%)
  736.   y1%=y1% 
  737.  32+1
  738.   y2%=y2% 
  739.  32+1
  740. a.  TextPtr%=(!textanchor%)+(y1%-1)*LenLine%
  741.  y2%>Count% 
  742.  y2%=Count%
  743.  I%=y1% 
  744. draw_line(I%)
  745.     TextPtr%+=LenLine%
  746. draw_line(Line%)
  747.  x0%,y0%-(Line%-1)*32-4
  748.  TextPtr%?L%=12 
  749.  "OS_WriteN",TextPtr%,LenLine%
  750.  Menu handling -------------------------------------------------------
  751. make_menus
  752. menu%(10)=
  753. create_menu(menu_ptr%,260,"Field,Index field...,Analyse months,Global changes>"+
  754. (changeW%)+",Link to table...,Combine fields>"+
  755. (calcW%)+",Start editing,Clear contents,Warn of delete,Save contents>"+
  756. (saveW%)+",Undo changes")
  757. uOmenic%=menu%(10)+28+(1*24):AnalyseFunc%=menic%!12:menic%!16=-1:menic%!20=14
  758. vLmenic%=menu%(10)+28+(4*24):CalcFunc%=menic%!12:menic%!16=-1:menic%!20=14
  759. w?menu%(13)=
  760. create_menu(menu_ptr%,120,"Interval:,"+
  761. 13,"0"))
  762. menic%=menu%(13)+28
  763. y>Interval%=menic%!12:menic%!16=buff%:$buff%="A0-9":buff%+=5
  764. z0?menic%=?menic% 
  765.  (1<<2):$Interval%="10 min"
  766. {smenu%(12)=
  767. create_menu(menu_ptr%,160,"Save indices,Automatic>"+
  768. (menu%(13))+",Warning>"+
  769. (menu%(13))+",Manual")
  770. menu%(2)=
  771. create_menu(menu_ptr%,265,"Validation,Create table...,~Display table,Show table files,Validate input,Show relations")
  772. tick(menu%(2),3,
  773. tick(menu%(10),7,
  774. menu%(7)=
  775. create_menu(menu_ptr%,260,"Misc.,Batch delete!"+
  776. (moveW%)+",Set passwords...,Colours!"+
  777. (colW%)+",Save indices>"+
  778. (menu%(12))+",Edit template")
  779. Nmenu%(15)=
  780. create_menu(menu_ptr%,90,"Separator,Comma,TAB,CR,LF,"+
  781. 13,"0"))
  782. menic%=menu%(15)+28+(4*24)
  783. -Delim%=menic%!12:menic%!16=-1:menic%!20=3
  784. '?menic%=?menic% 
  785.  (1<<2):$Delim%=""
  786. ]menu%(20)=
  787. create_menu(menu_ptr%,90,"Terminator,CR,LF,LF CR,CR LF,CR CR,LF LF,"+
  788. 13,"0"))
  789. menic%=menu%(20)+28+(6*24)
  790. .Termin%=menic%!12:menic%!16=-1:menic%!20=3
  791. (?menic%=?menic% 
  792.  (1<<2):$Termin%=""
  793. string$="Print,Match,Show resources,Show jobs done,Options...,Save options!"+
  794. (saveW%)+",Save query!"+
  795. (saveW%)+",~Numeric fields>"+
  796. (pselectW%)+",~Save selection!"+
  797. (saveW%)+",~Clear selection"
  798. >menu%(6)=
  799. create_menu(menu_ptr%,260,string$+",Select all")
  800. zstring$="Powerbase,Information!"+
  801. (miscW%)+",Field: ''>"+
  802. (menu%(10))+",Print>"+
  803. (menu%(6))+",Validation>"+
  804. (menu%(2))
  805. string2$=",Current key...,Miscellaneous>"+
  806. (menu%(7))+",Show keypad,Export subset!"+
  807. (savesubW%)+",Export CSV!"+
  808. (savesubW%)+",CSV options...,Save choices,Undo changes,Help"
  809. 9menu%(1)=
  810. create_menu(menu_ptr%,236,string$+string2$)
  811. #Fieldpos%=menu%(1)+28+(1*24)+12
  812. Jmenu%(4)=
  813. create_menu(menu_ptr%,200,"Print tree,Complete,Totals only")
  814. <menu%(22)=
  815. create_menu(menu_ptr%,120,"Every:,"+
  816. 13,"0"))
  817. menic%=menu%(22)+28
  818. ;Every%=menic%!12:menic%!16=buff%:$buff%="A0-9":buff%+=5
  819. .?menic%=?menic% 
  820.  (1<<2):$Every%="25 recs"
  821. Xmenu%(21)=
  822. create_menu(menu_ptr%,160,"Balance,Automatic>"+
  823. (menu%(22))+",Right now")
  824. menu%(3)=
  825. create_menu(menu_ptr%,300,"Utilities,New primary key...,Adjust format,New record format,Merge database,~Change length>"+
  826. (sizeW%)+",Balance index>"+
  827. (menu%(21))+",Print index>"+
  828. (menu%(4))+",Find duplicates,Warn of duplicates")
  829. menu%(0)=
  830. create_menu(menu_ptr%,256,"\Powerbase,Information>"+
  831. (infoW%)+",New database!"+
  832. (saveW%)+",~Utilities>"+
  833. (menu%(3))+",~Close database,Save choices,Default choices,Help,Quit")
  834. menu%(9)=
  835. create_menu(menu_ptr%,270,"New database,Design field...,~_Default database,~Save form file!"+
  836. (saveW%)+",~Database size>"+
  837. (sizeW%)+",~Primary key...,~Quit design")
  838. jmenu%(17)=
  839. create_menu(menu_ptr%,200,"Table,Clear,Save!"+
  840. (saveW%)+",Print,Sort,Undo change,Undo all")
  841. Vmenu%(18)=
  842. create_menu(menu_ptr%,250,"List,Save as text!"+
  843. (saveW%)+",Sort,Scrap")
  844. menu$="Data"
  845.  I%=0 
  846.   menu$+=","+vname$(I%)
  847. Bmenu%(8)=
  848. create_menu(menu_ptr%,200,menu$):
  849. tick(menu%(8),1,
  850. menu$="External"
  851.  I%=36 
  852.   menu$+=","+vname$(I%)
  853. Dmenu%(11)=
  854. create_menu(menu_ptr%,180,menu$):
  855. tick(menu%(11),0,
  856. menu$="Check box"
  857.  I%=41 
  858.   menu$+=","+vname$(I%)
  859. Dmenu%(14)=
  860. create_menu(menu_ptr%,180,menu$):
  861. tick(menu%(14),0,
  862. menu$="Stamp"
  863.  I%=46 
  864.   menu$+=","+vname$(I%)
  865. Dmenu%(16)=
  866. create_menu(menu_ptr%,250,menu$):
  867. tick(menu%(16),0,
  868. menu$="Button"
  869.  I%=9 
  870.   menu$+=","+vname$(I%)
  871. Dmenu%(19)=
  872. create_menu(menu_ptr%,270,menu$):
  873. tick(menu%(19),0,
  874. ybar%=96+8*44
  875. field_menu(menu%,N%)
  876.  F%,P%,L%,D$,F$
  877. $menu%="Field list"
  878. Smenu%?12=7:menu%?13=2:menu%?14=7:menu%?15=0:menu%!16=270:menu%!20=44:menu%!24=0
  879. P%=menu%+28
  880.  F%=1 
  881. "  F$=
  882. (F%):F$=
  883. (F$)," ")+F$
  884. 7  D$=
  885. text(mainW%,desc%(F%)),7):D$+=
  886. (D$)," ")
  887. &  F$+=" "+D$+" "+Tag$(F%):L%=
  888. A  !P%=0:P%!4=-1:P%!8=&7000121:P%!12=buff%:P%!16=-1:P%!20=L%+1
  889.   $buff%=F$:buff%+=L%+1
  890.   P%+=24
  891. P%!-24=P%!-24 
  892. create_menu(
  893.  menu%,width%,list$)
  894.  start%,choice$,entries%,item%,P%,Q%,S%,shaded%
  895. start%=menu%
  896. list$,1)="\" 
  897.  (RISCOS3=
  898.  leftmenu%=
  899.  list$=
  900. list$,2)
  901. list$,",")
  902. $menu%=
  903. list$,P%-1)
  904. menu%?12=7:menu%?13=2
  905. menu%?14=7:menu%?15=0
  906. *menu%!16=width%:menu%!20=44:menu%!24=0
  907. item%=menu%+28
  908. list$+=","
  909. entries%=0
  910.   Q%=P%+1
  911.   P%=
  912. list$,",",Q%)
  913.  P%>0 
  914.     !item%=0:shaded%=0
  915.      choice$=
  916. list$,Q%,P%-Q%)
  917. ?    
  918. choice$,1)="~" 
  919.  choice$=
  920. choice$,2):shaded%=(1<<22)
  921. A    
  922. choice$,1)="_" 
  923.  choice$=
  924. choice$,2):?item%=?item% 
  925.     S%=
  926. choice$,"!")
  927. 5    
  928.  S%>0 
  929.  ?item%=?item% 
  930. choice$,S%,1)=">"
  931.     S%=
  932. choice$,">")
  933.  S%=0 
  934.       item%!4=-1
  935.       
  936. #      item%!4=
  937. choice$,S%+1))
  938.        choice$=
  939. choice$,S%-1)
  940.         
  941. (choice$)<=12 
  942.       $(item%+12)=choice$
  943.       item%!8=&7000021
  944.       
  945.       L%=
  946. (choice$)+1
  947. I      item%!12=buff%:$buff%=choice$:buff%+=L%:item%!16=-1:item%!20=L%
  948.       item%!8=&7000121
  949.         
  950. !    item%!8=item%!8 
  951.  shaded%
  952.     item%+=24
  953.     entries%+=1
  954.  P%=0
  955. item%!-24=item%!-24 
  956. menu%=item%
  957.  menu%>men_end% 
  958.  0,"Not enough room for menus (internal error code 50)"
  959. =start%
  960. tick(menu%,item%,on%)
  961. item%=menu%+28+item%*24
  962.  on% 
  963. :?item%=?item% 
  964. :?item%=?item% 
  965. tick_one(menu%,first%,last%,item%)
  966.  I%=first% 
  967.  last%
  968. tick(menu%,I%,(I%=item%))
  969. ticked(menu%,item%)
  970. item%=menu%+28+item%*24
  971.  (?item% 
  972. lit(menu%,item%,on%)
  973. item%=menu%+28+item%*24
  974.  on% 
  975. : item%!8=item%!8 
  976.  (1<<22)
  977. : item%!8=item%!8 
  978.  (1<<22)
  979. show_menu(menu%,x%,y%)
  980. )menuhandle%=menu%:menux%=x%:menuy%=y%
  981.  "Wimp_CreateMenu",,menu%,x%,y%
  982.  Icon handling -------------------------------------------------------
  983. create_icon(whandle%,xmin%,ymin%,width%,height%,iconflags%,text$,d1%,d2%,d3%)
  984.  handle%
  985. block%!0=whandle%
  986. !block%!4=xmin%:block%!8=ymin%
  987. 2block%!12=xmin%+width%:block%!16=ymin%+height%
  988. block%!20=iconflags%
  989.  d1%=0 
  990.   $(block%+24)=text$
  991.   block%!24=d1%
  992.   block%!28=d2%
  993.   block%!32=d3%
  994.  "Wimp_CreateIcon",,block% 
  995.  handle%
  996. =handle%
  997. redraw_icon(wi%,ic%)
  998. !block%=wi%:block%!4=ic%
  999. block%!8=0:block%!12=0
  1000.  "Wimp_SetIconState",,block%
  1001. **block%!8=0:block%!12=wi%:block%!16=ic%
  1002. icon_bit(bit%,wi%,ic%,on%)
  1003. !block%=wi%
  1004. block%!4=ic%
  1005.  on% 
  1006. :block%!8=0:block%!12=1<<bit%
  1007. :block%!8=1<<bit%:block%!12=1<<bit%
  1008.  "Wimp_SetIconState",,block%
  1009. select(wi%,ic%)
  1010. !block%=wi%:block%!4=ic%
  1011. 9"block%!8=1<<21:block%!12=1<<21
  1012.  "Wimp_SetIconState",,block%
  1013. deselect(wi%,ic%)
  1014. !block%=wi%:block%!4=ic%
  1015. ? block%!8=0:block%!12=(1<<21)
  1016.  "Wimp_SetIconState",,block%
  1017. invert(wi%,ic%)
  1018. selected(wi%,ic%) 
  1019. deselect(wi%,ic%) 
  1020. select(wi%,ic%)
  1021. set_icon(wi%,ic%,on%)
  1022.  on% 
  1023. select(wi%,ic%) 
  1024. deselect(wi%,ic%)
  1025. selected(wi%,ic%)
  1026. !block%=wi%:block%!4=ic%
  1027.  "Wimp_GetIconState",,block%
  1028. =((block%!24) 
  1029.  (1<<21))>0
  1030. shaded(wi%,ic%)
  1031. !block%=wi%:block%!4=ic%
  1032.  "Wimp_GetIconState",,block%
  1033. =((block%!24) 
  1034.  (1<<22))>0
  1035. selected_esg(wi%,esg%)
  1036.  "Wimp_WhichIcon",wi%,block%,&003F0000,&00200000+(esg%<<16)
  1037. =!block%
  1038. next_writeable(wi%,ic%,d%,r%)
  1039.  P%,E%,next%
  1040.  "Wimp_WhichIcon",wi%,block%,&00C0E000,(14<<12)
  1041.   E%+=4
  1042.  block%!E%=-1
  1043.  block%!P%<>ic% 
  1044.  P%<E%
  1045.   P%+=4
  1046.  P%=E% 
  1047.  P%-=4
  1048.  r%=1 
  1049.  P%+4=E% 
  1050.  0:P%=E%
  1051.  2:P%=-4
  1052. :P%+=4*d%
  1053.  E%:next%=!block%
  1054.  -4:next%=block%!(E%-4)
  1055. :next%=block%!P%
  1056. set_caret(wi%,next%)
  1057. text(wi%,ic%)
  1058. !block%=wi%:block%!4=ic%
  1059.  "Wimp_GetIconState",,block%
  1060. =block%!28
  1061. val(wi%,ic%)
  1062. !block%=wi%:block%!4=ic%
  1063.  "Wimp_GetIconState",,block%
  1064. =block%!32
  1065. text_length(wi%,ic%)
  1066. !block%=wi%:block%!4=ic%
  1067.  "Wimp_GetIconState",,block%
  1068. ($(block%!28))
  1069. set_caret(handle%,ic%)
  1070.  ic%=-1 
  1071.  "Wimp_SetCaretPosition",handle%,ic%
  1072.  "Wimp_SetCaretPosition",handle%,ic%,0,0,-1,
  1073. text_length(handle%,ic%)
  1074. alter_flags(dfg%,ffg%,bfg%)
  1075.  ic%,F%
  1076. !block%=mainW%
  1077.  ic%=0 
  1078.  fields%*2-1
  1079.   F%=(ic%+1) 
  1080. 1  block%!4=ic%:
  1081.  "Wimp_GetIconState",,block%
  1082.  (ic% 
  1083.  2)=1 
  1084.  chartype%(F%) 
  1085. U      
  1086.  0,1,2,3,4,5,6,7,8,40,46,47,48,49,50,51,52,53,54,55,56,57,58:block%!8=ffg%
  1087. '      
  1088.  39:block%!8=ffg%:len%(F%)=0
  1089. B      
  1090.  logosloaded% 
  1091.  block%!8=&0000611E 
  1092.  block%!8=ffg%
  1093.       
  1094. :block%!8=bfg%
  1095.         
  1096.  block%!8=dfg%
  1097.   block%!12=&FFFFFFFF
  1098.  "Wimp_SetIconState",,block%
  1099. limit_actions(off%)
  1100. icon_bit(22,keypadW%,ic%,off%)
  1101.  buttonfield%(ic%)>0 
  1102. icon_bit(22,mainW%,field%(buttonfield%(ic%)),off%)
  1103.  ic%=-1
  1104. lit(menu%(10),0,off%)
  1105. lit(menu%(10),1,off%)
  1106. lit(menu%(10),2,off%)
  1107.  12,14,15,16,17,18,20,21,22,-1
  1108. identify_field(ic%)
  1109. .Fieldnumber%=0:Fieldname$="":TextLength%=0
  1110.  (ic% 
  1111.  2)=1 
  1112. !  !block%=mainW%:block%!4=ic%
  1113.  "Wimp_GetIconState",,block%
  1114.   TextLength%=block%!36-1
  1115.   Fieldnumber%=(ic%+1) 
  1116. 3  Fieldname$=$
  1117. text(mainW%,desc%(Fieldnumber%))
  1118.  Fieldname$="" 
  1119.  Fieldname$=Tag$(Fieldnumber%)
  1120.  chartype%(Fieldnumber%) 
  1121. $    
  1122.  2,4:
  1123.  "OS_Byte",202,0,239
  1124. !    
  1125.  "OS_Byte",202,16,111
  1126.  "OS_Byte",118
  1127. first_field
  1128.  I%+=1
  1129.  (len%(I%)>0 
  1130.  chartype%(I%)<6) 
  1131.  I%>fields%
  1132.  I%>fields% 
  1133.  Mouse_click processing ----------------------------------------------
  1134. mouse(x%,y%,b%,wi%,ic%)
  1135. oldx%=x%:oldy%=y%
  1136. Cblock%!0=x%:block%!4=y%:block%!8=b%:block%!12=wi%:block%!16=ic%
  1137.  (b% 
  1138.  2)<>2 
  1139.  (design% 
  1140.  (wi%=mainW%)) 
  1141.  "Interface_SlabButton",,block%
  1142.  wi% 
  1143. iconbar_click
  1144.  accessW%:accessbutton%=ic%
  1145.  mainW%:
  1146. main_click
  1147.  keypadW%:
  1148. keypad_click(wi%,ic%,b%)
  1149.  saveW%,savesubW%:
  1150. save_click(wi%,ic%,b%)
  1151.  keyW%:
  1152. key_click
  1153.  tableW%:
  1154. create_table
  1155.  linkW%:
  1156. link_to_table
  1157.  passW%:
  1158. passwords
  1159.  printW%:
  1160. print_click
  1161.  matchW%:
  1162. match_click(b%,wi%,ic%)
  1163.  createW%:
  1164. create_click
  1165.  datadicW%:
  1166. datadic_click
  1167.  changeW%:
  1168. change_click
  1169.  moveW%:
  1170. move_click
  1171.  listW%:
  1172. list_click(x%,y%,b%,wi%)
  1173.  colW%:
  1174. set_colours
  1175.  calcW%:
  1176.  ic%=1 
  1177. calc_formula($CalcForm%)
  1178.  labelW%:
  1179.  ic% 
  1180. ;    
  1181. icon_bit(22,labelW%,12,
  1182. selected(labelW%,11))
  1183. %    
  1184.  "Wimp_CreateMenu",,-1
  1185.  mergeW%:
  1186. merge_click
  1187.  sizeW%:
  1188. size_click
  1189.  csvW%:
  1190. csv_click
  1191.  pselectW%,relateW%,reformW%,infoW%,miscW%:
  1192.  ### No action on these ###
  1193. special_click
  1194. *block%!8=0:block%!12=wi%:block%!16=ic%
  1195.  "Interface_SlabButton",,block%
  1196. change_click
  1197.  (b% 
  1198.  %111)=4 
  1199.  ic% 
  1200. changes(key%)
  1201.      
  1202. commoncase(wi%,ic%)
  1203. move_click
  1204.  (b% 
  1205.  %111)=4 
  1206.  ic% 
  1207. clear
  1208.      
  1209. commoncase(wi%,ic%)
  1210. csv_click
  1211.  (b% 
  1212.  %111) 
  1213.  2,4:
  1214.  ic% 
  1215. 0    
  1216. show_menu(menu%(15),oldx%+32,oldy%)
  1217. 0    
  1218. show_menu(menu%(20),oldx%+32,oldy%)
  1219.  (b% 
  1220.  %111) 
  1221.  ic% 
  1222.     6    
  1223. icon_bit(22,csvW%,4,(
  1224. selected(csvW%,1)))
  1225. *    
  1226. convert_csv($
  1227. text(csvW%,13))
  1228. !    
  1229. close_window(csvW%)
  1230. merge_click
  1231.  (b% 
  1232.  %111)=4 
  1233.  z%=1 
  1234.  z%=-1
  1235.  ic% 
  1236.  4:ClientPtr%=
  1237. merge_next(ClientPtr%,z%)
  1238.  9:ClientPtr%=
  1239. merge_next(ClientPtr%,-z%)
  1240.  11:ClientPtr%=
  1241. merge_next(top,z%)
  1242.  10:ClientPtr%=
  1243. merge_next(top,-z%)
  1244. commoncase(wi%,ic%)
  1245.  "Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Print",,,,printtag%,mytask%
  1246.   mergenum%=0
  1247. C  ClientSearch$=
  1248. parse($
  1249. text(mergeW%,3),
  1250. selected(mergeW%,12))
  1251. #  ClientPtr%=
  1252. merge_next(top,1)
  1253. perform_close(mergeW%)
  1254. size_click
  1255. ($Records%)<=0:
  1256. softerror("",71)
  1257. &,  $Records%="100":
  1258. redraw_icon(sizeW%,1)
  1259. ($Increment%)<0
  1260. softerror("",72)
  1261. )-  $Increment%="25":
  1262. redraw_icon(sizeW%,3)
  1263.  present%=7 
  1264. change_length(
  1265. ($Records%),
  1266.  "Wimp_CreateMenu",,-1
  1267. datadic_click
  1268.  %111 
  1269. 38  !block%=datadicW%:
  1270.  "Wimp_GetWindowState",,block%
  1271.  "Wimp_SetCaretPosition",datadicW%,ic%,x%-block%!4+block%!20,y%,-1,-1
  1272. show_menu(menu%(17),x%-64,y%-20)
  1273.  ic%>=0 
  1274. 8%    field%=(ic% 
  1275.  (TabFields%+1))
  1276. invert(wi%,field%)
  1277.     field$=
  1278. (field%)
  1279. ;!    
  1280. selected(wi%,field%) 
  1281. <)      printrel$(Tablenumber%)+=field$
  1282.       
  1283. >-      P%=
  1284. printrel$(Tablenumber%),field$)
  1285. ?_      printrel$(Tablenumber%)=
  1286. printrel$(Tablenumber%),P%-1)+
  1287. printrel$(Tablenumber%),P%+1)
  1288. @        
  1289. list_click(x%,y%,b%,wi%)
  1290.  (b% 
  1291.  %111) 
  1292. show_menu(menu%(18),x%-64,y%-20)
  1293.   !block%=wi%
  1294.  "Wimp_GetWindowState",,block%
  1295. L,  line%=(block%!16-block%!24-y%+32) 
  1296. M*  column%=(x%-block%!4+block%!20) 
  1297.   RecPtr%=!recanchor%
  1298.   R%=RecPtr%!(line%*4)
  1299.   E%=
  1300. (Form$) 
  1301.  R%>=0 
  1302. R&    addr=
  1303. find("#"+
  1304. (R%),key%,1,
  1305.  format$ 
  1306.       
  1307.  "horiz","table"
  1308.       
  1309.         N%+=1
  1310. W&      
  1311.  Tab%(N%)>column%+1 
  1312.  N%=E%
  1313. X$      F%=
  1314. fnum(
  1315. Form$,N%*2-1,2))
  1316.       
  1317.  "vert":
  1318.       
  1319.         N%+=1:line%-=1
  1320. \)      
  1321.  RecPtr%!(line%*4)<>R% 
  1322.  N%=E%
  1323. ]$      F%=
  1324. fnum(
  1325. Form$,N%*2-1,2))
  1326. ^"      
  1327.  "tree":F%=KF%(tkey%,0)
  1328.       
  1329.  "dup":F%=KF%(0,0)
  1330. `        
  1331. a;    
  1332.  chartype%(F%)<=10 
  1333. set_caret(mainW%,field%(F%))
  1334.     Fieldnumber%=F%
  1335. match_click(b%,wi%,ic%)
  1336.  not%,and%,or%
  1337.  b%=2 
  1338. show_menu(menu%(1),x%-64,y%-20):
  1339. selected_esg(printW%,4) 
  1340.  38:reportdest$="Window"
  1341.  39:reportdest$="File"
  1342.  41:reportdest$="Printer"
  1343.  ic% 
  1344. commoncase(wi%,ic%)
  1345. selected(matchW%,27) 
  1346. text(matchW%,25)="Number found" 
  1347. text(matchW%,25)="Time taken"
  1348. redraw_icon(matchW%,25)
  1349.  1,24:
  1350.  ic%=24 
  1351.  Search$="":displayed%=
  1352.  Search$=
  1353. parse($
  1354. text(matchW%,0),
  1355. selected(matchW%,16)):displayed%=
  1356.  Search$<>"FALSE" 
  1357.     $
  1358. text(matchW%,14)=""
  1359. x     
  1360. redraw_icon(matchW%,14)
  1361.  reportdest$ 
  1362. z9      
  1363.  "Window","Printer":
  1364. do_it(Search$,displayed%)
  1365.       
  1366.  "File":
  1367.       savefunc$="Save list"
  1368. }1      $SaveName%=$database%+".PrintJobs.List"
  1369. ~4      $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
  1370. :      !block%=matchW%:
  1371.  "Wimp_GetWindowState",,block%
  1372. ,      xmin%=block%!4+200:ymax%=block%!16
  1373. 9      !block%=saveW%:
  1374.  "Wimp_GetWindowState",,block%
  1375. ;      block%!12=xmin%+block%!12-block%!4:block%!4=xmin%
  1376. ;      block%!8=ymax%-block%!16+block%!8:block%!16=ymax%
  1377. 3      block%!28=-1:
  1378.  "Wimp_OpenWindow",,block%
  1379.       
  1380. set_caret(saveW%,0)
  1381.         
  1382.  (b% 
  1383.  %111)=4 
  1384. selected(matchW%,27) 
  1385. close_window(matchW%):
  1386. set_caret(mainW%,-1)
  1387.  21,22:
  1388.  (b% 
  1389.  %111)=4 
  1390.  z%=1 
  1391.  (b% 
  1392.  %111)=1 
  1393.  z%=-1
  1394.  ic%=21 
  1395.  Match_tag%+=z% 
  1396.  Match_tag%-=z%
  1397.  Match_tag%>fields% 
  1398.  Match_tag%=1
  1399.  Match_tag%<1 
  1400.  Match_tag%=fields%
  1401. text(matchW%,3)=Tag$(Match_tag%)
  1402. redraw_icon(matchW%,3)
  1403. tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
  1404. show_menu(fieldmenu%,oldx%+32,oldy%)
  1405. "  op%=
  1406. selected_esg(matchW%,1)
  1407.  op% 
  1408.  5:op$="="
  1409.  6:op$="{"
  1410.  7:op$="<"
  1411.  8:op$=">"
  1412.  15:op$="<>"
  1413.  18:op$=">="
  1414.  19:op$="<="
  1415.  20:op$="}{"
  1416. 4  not%=
  1417. selected(matchW%,4):
  1418. deselect(matchW%,4)
  1419. 6  and%=
  1420. selected(matchW%,12):
  1421. deselect(matchW%,12)
  1422. 5  or%=
  1423. selected(matchW%,13):
  1424. deselect(matchW%,13)
  1425.   tag$=$
  1426. text(matchW%,3)
  1427. !  contents$=$
  1428. text(matchW%,9)
  1429.   new$=tag$+op$+contents$
  1430.  not% 
  1431.  new$="NOT ("+new$+")"
  1432.  and% 
  1433.  new$+=" AND "
  1434.  or% 
  1435.  new$+=" OR "
  1436. text(matchW%,0)=$
  1437. text(matchW%,0)+new$:
  1438. redraw_icon(matchW%,0)
  1439. text(matchW%,9)="":
  1440. redraw_icon(matchW%,9)
  1441.  24:reportdest$="Window":
  1442. do_it("",
  1443.  (b% 
  1444.  %111)=4 
  1445. selected(matchW%,27) 
  1446. close_window(matchW%):
  1447. set_caret(mainW%,-1)
  1448. iconbar_click
  1449.  %111 
  1450. selected(passW%,12) 
  1451. close_window(saveW%)
  1452. (    
  1453. show_menu(menu%(0),x%-64,ybar%)
  1454.  $dbase%="No data" 
  1455.     $SaveName%="!DataBase"
  1456. 2    $SaveSprite%="snew_appl;Pptr_hand,12,8;B3"
  1457.     savefunc$=choice$(1)
  1458. 1    
  1459.  "Wimp_CreateMenu",,saveW%,x%-50,y%+300
  1460. show_windows
  1461. main_click
  1462.  P%,F%,H$,L%,T%,N$,field$
  1463.  present%=7 
  1464.  adjust%=
  1465. validate(Fieldnumber%,T%,N$)=
  1466. update_calcs(Fieldnumber%)
  1467.  flash% 
  1468. deselect(mainW%,field%(flash%)):flash%=
  1469.  present% 
  1470.  0,3:
  1471. design_field
  1472. first_field>0 
  1473. default_key
  1474. design_field
  1475.  5,7:
  1476.  adjust% 
  1477. design_field
  1478.         
  1479. identify_field(ic%)
  1480. &    
  1481.  relations%=
  1482. relations(
  1483.  2047 
  1484.       
  1485. ,      
  1486. selected(passW%,11) 
  1487.  Modify% 
  1488.         
  1489. set_up_field_menu
  1490. ,        
  1491. show_menu(menu%(1),x%-64,y%-20)
  1492.       
  1493.       
  1494. &      
  1495.  chartype%(Fieldnumber%) 
  1496.         
  1497.  41,42,43,44,45:
  1498.         
  1499. invert(wi%,ic%)
  1500. (        col%=
  1501. get_icon_cols(wi%,ic%)
  1502. 4        col%=((col%>>4) 
  1503.  (col%<<4)) 
  1504.  %11111111
  1505. (        
  1506. set_icon_cols(wi%,ic%,col%)
  1507. %        boxon%=((col% 
  1508.  %1111)<2)
  1509. %        
  1510. update_selection(boxon%)
  1511.       
  1512.       
  1513. &      
  1514.  chartype%(Fieldnumber%) 
  1515. 9        
  1516. filter(mainW%,field%(buttonfield%(22)))
  1517.         
  1518.  41,42,43,44,45:
  1519. &        
  1520. (-3) 
  1521. invert(wi%,ic%)
  1522. Q        
  1523. selected(wi%,ic%) 
  1524.  $Rf%(Fieldnumber%)=" " 
  1525.  $Rf%(Fieldnumber%)=""
  1526.         
  1527. relations(
  1528.       
  1529.       
  1530.  256:
  1531. &      
  1532.  chartype%(Fieldnumber%) 
  1533. J        
  1534.  0,1,2,3,4,5,6,7,8,36,39,46,47,48,49,50,51,52,53,54,55,56,57:
  1535.         
  1536. invert(wi%,ic%)
  1537. 1        
  1538. update_selection(
  1539. selected(wi%,ic%))
  1540. }        
  1541.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  1542. keypad_click(wi%,chartype%(Fieldnumber%)-9,1)
  1543.       
  1544.       
  1545.  1024:
  1546.       
  1547. (-3) 
  1548. .        
  1549.  "Wimp_GetCaretPosition",,block%
  1550. $        wi%=!block%:ic%=block%!4
  1551.         
  1552.  wi% 
  1553. (          
  1554.  matchW%:
  1555.  ic%<>0 
  1556.  wi%=0
  1557. *          
  1558.  keypadW%:
  1559.  ic%<>29 
  1560.  wi%=0
  1561. (          
  1562.  mergeW%:
  1563.  ic%<>3 
  1564.  wi%=0
  1565.           
  1566. :wi%=0
  1567.         
  1568.         
  1569.  wi%<>0 
  1570. 1          $
  1571. text(wi%,ic%)+=Tag$(Fieldnumber%)
  1572. !          
  1573. set_caret(wi%,ic%)
  1574. #          
  1575. redraw_icon(wi%,ic%)
  1576.         
  1577.         
  1578. (        
  1579.  chartype%(Fieldnumber%) 
  1580.           
  1581.  0,1,2,3,4,5,8:
  1582.            
  1583.  Fieldnumber%>0 
  1584. ?            !block%=mainW%:
  1585.  "Wimp_GetWindowState",,block%
  1586. `            
  1587.  Access% 
  1588.  "Wimp_SetCaretPosition",mainW%,ic%,x%-block%!4+block%!20,y%,-1,-1
  1589.           
  1590. {          
  1591. link$(Fieldnumber%),1)="@" 
  1592.  "OS_CLI","Filer_OpenDir "+
  1593. link$(Fieldnumber%),2) 
  1594. softerror("",91)
  1595. N          
  1596.  36,37,38:
  1597. edit_blob(REC%,Fieldnumber%,chartype%(Fieldnumber%))
  1598.           
  1599.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  1600. keypad_click(wi%,chartype%(Fieldnumber%)-9,4)
  1601.           
  1602. match
  1603.           
  1604.           
  1605.  34:quit%=
  1606.         
  1607.       
  1608.         
  1609. set_up_field_menu
  1610. tick_one(menu%(5),0,LastTable%,LastTable%+1)
  1611.  Fieldnumber%>0 
  1612. lit(menu%(1),1,
  1613.   $AnalyseFunc%="Analyse"
  1614. -  $Fieldpos%="Field: "+Tag$(Fieldnumber%)
  1615.   $LinkTitle%=Fieldname$
  1616. '  $CalcForm%=Tag$(Fieldnumber%)+"="
  1617.  I%=0 
  1618. lit(menu%(10),I%,
  1619.    V%=chartype%(Fieldnumber%)
  1620.  5,50,51:
  1621.  &    isadate%=
  1622. lit(menu%(10),1,
  1623. !&    $AnalyseFunc%="Analyse months"
  1624. :isadate%=
  1625. is_a_key(Fieldnumber%)>=0 
  1626. lit(menu%(10),1,
  1627. &_    
  1628.  isadate%=
  1629. selected(mainW%,field%(Fieldnumber%)) 
  1630.  $AnalyseFunc%="Analyse index"
  1631.  0,1,2,3,4,5:
  1632. *!    
  1633. lit(menu%(10),0,Access%)
  1634. +!    
  1635. lit(menu%(10),2,Access%)
  1636. ,!    
  1637. lit(menu%(10),3,Access%)
  1638. -!    
  1639. lit(menu%(10),5,Access%)
  1640. .!    
  1641. lit(menu%(10),9,Access%)
  1642. /4    Keyfld0%=Fieldnumber%:Keyfld1%=0:$F2dkey%=""
  1643. 0#    $F1dkey%=Tag$(Fieldnumber%)
  1644. 1(    keylimit%=TextLength%:$KeyNo%=""
  1645. 22    WD%()=0:WD%(0)=keylimit%:keylen%=keylimit%
  1646.  J%=0 
  1647.       $Wkey%(J%)=
  1648. (WD%(J%))
  1649. 6*    $ChangeTitle%="Field: "+Fieldname$
  1650.     $
  1651. text(changeW%,1)=""
  1652. 8+    
  1653.  common% 
  1654. text(changeW%,3)=""
  1655. link_status
  1656. ;!    
  1657. lit(menu%(10),4,Modify%)
  1658. <!    
  1659. lit(menu%(10),3,Access%)
  1660. =$    
  1661. calc_link("Calculations",6)
  1662. link_status
  1663. @!    
  1664. lit(menu%(10),4,Modify%)
  1665. A!    
  1666. lit(menu%(10),3,Access%)
  1667. B&    
  1668. calc_link("Combine fields",7)
  1669. link_status
  1670. D.    
  1671.  46,47,48,49,50,51,52,53,54,55,56,57:
  1672.  V%=47 
  1673. F#      
  1674. lit(menu%(10),4,Modify%)
  1675. G)      
  1676. calc_link("Set base value",47)
  1677. H        
  1678. I!    
  1679. lit(menu%(10),0,Access%)
  1680. J4    Keyfld0%=Fieldnumber%:Keyfld1%=0:$F2dkey%=""
  1681. Kt    
  1682.  Fieldname$<>Tag$(Fieldnumber%) 
  1683.  $F1dkey%=
  1684. Fieldname$,8)+" ("+Tag$(Fieldnumber%)+")" 
  1685.  $F1dkey%=Fieldname$
  1686. L(    keylimit%=TextLength%:$KeyNo%=""
  1687. M2    WD%()=0:WD%(0)=keylimit%:keylen%=keylimit%
  1688.  J%=0 
  1689.       $Wkey%(J%)=
  1690. (WD%(J%))
  1691.  36,39:
  1692. RD    
  1693. blob_path(
  1694. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  1695. S#      
  1696. lit(menu%(10),6,Access%)
  1697.       
  1698. lit(menu%(10),7,
  1699.       
  1700. lit(menu%(10),8,
  1701.       $SaveName%="TextFile"
  1702. W4      $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
  1703.       savefunc$="Save text"
  1704. Y        
  1705.  37,40:
  1706. [D    
  1707. blob_path(
  1708. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  1709. \#      
  1710. lit(menu%(10),6,Access%)
  1711.       
  1712. lit(menu%(10),7,
  1713.       
  1714. lit(menu%(10),8,
  1715.       $SaveName%="Sprite"
  1716. `4      $SaveSprite%="sfile_ff9;Pptr_hand,12,8;B3"
  1717. a!      savefunc$="Save sprite"
  1718. b        
  1719. dD    
  1720. blob_path(
  1721. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  1722. e#      
  1723. lit(menu%(10),6,Access%)
  1724.       
  1725. lit(menu%(10),7,
  1726.       
  1727. lit(menu%(10),8,
  1728.       $SaveName%="DrawFile"
  1729. i4      $SaveSprite%="sfile_aff;Pptr_hand,12,8;B3"
  1730.       savefunc$="Save draw"
  1731. k        
  1732. lit(menu%(1),1,
  1733. ):$Fieldpos%="Field: ''"
  1734. update_selection(add%)
  1735.  P%,SP%,F%,SF%
  1736. s"F%=Fieldnumber%:SF%=(F% 
  1737.  128)
  1738. t-field$=
  1739. ~(F%):
  1740.  F%<16 
  1741.  field$="0"+field$
  1742. u2sfield$=
  1743. ~(SF%):
  1744.  SF%<16 
  1745.  sfield$="0"+sfield$
  1746.  add% 
  1747. (-1) 
  1748.  printorder$+=sfield$ 
  1749.  printorder$+=field$ 
  1750. enable_row(calcrow%?Fieldnumber%,
  1751. lit(menu%(6),7,
  1752. lit(menu%(6),8,
  1753. }$    P%=
  1754. printorder$,field$,P%+1)
  1755.  ((P%-1) 
  1756.  2)=0 
  1757.  P%=0
  1758.  P%>0 
  1759. 9    printorder$=
  1760. printorder$,P%-1)+
  1761. printorder$,P%+2)
  1762. ,    
  1763. enable_row(calcrow%?Fieldnumber%,
  1764.         
  1765.         
  1766. )      SP%=
  1767. printorder$,sfield$,SP%+1)
  1768. !    
  1769.  ((SP%-1) 
  1770.  2)=0 
  1771.  SP%=0
  1772.  SP%>0 
  1773. =      printorder$=
  1774. printorder$,SP%-1)+
  1775. printorder$,SP%+2)
  1776. .      
  1777. enable_row(calcrow%?Fieldnumber%,
  1778.  printorder$="" 
  1779. lit(menu%(6),7,
  1780. lit(menu%(6),8,
  1781. print_click
  1782.  (b% 
  1783.  %111) 
  1784. selected(printW%,26) 
  1785. show_menu(labelW%,x%-500,y%+200)
  1786.  1,4:
  1787.  ic% 
  1788.  23,24,25:
  1789. 6    
  1790. icon_bit(22,printW%,15,
  1791. selected(printW%,25))
  1792. 6    
  1793. icon_bit(22,printW%,45,
  1794. selected(printW%,25))
  1795. 6    
  1796. icon_bit(22,printW%,15,
  1797. selected(printW%,25))
  1798. 6    
  1799. icon_bit(22,printW%,45,
  1800. selected(printW%,25))
  1801. )    
  1802. show_menu(labelW%,x%-500,y%+200)
  1803. =    
  1804. drag_options("<Pbase$Dir>.Resources.PrintOpts")
  1805. close_window(printW%)
  1806. 6    
  1807.  (b% 
  1808.  %111)=1 
  1809. open_window(matchW%):
  1810. match
  1811. keypad_click(wi%,ic%,b%)
  1812.  handle%,icon%,T%,N$,date$
  1813. close_window(relateW%)
  1814.  flash% 
  1815. deselect(mainW%,field%(flash%)):flash%=
  1816.  ic%<>12 
  1817. validate(Fieldnumber%,T%,N$)=
  1818. update_calcs(Fieldnumber%)
  1819.  (b% 
  1820.  %111) 
  1821.  1,4:
  1822.  (b% 
  1823.  %111)=4 
  1824.  z%=1 
  1825.  z%=-1
  1826.  ic% 
  1827. ,    
  1828. scan(z%,
  1829. text(keypadW%,23)))
  1830.  1:stop%=
  1831. %    
  1832.  2:addr=
  1833. moveto(key%,top,z%)
  1834. &    
  1835.  3:addr=
  1836. moveto(key%,top,-z%)
  1837. &    
  1838.  4:addr=
  1839. moveto(key%,addr,z%)
  1840. '    
  1841.  5:addr=
  1842. moveto(key%,addr,-z%)
  1843. (    
  1844.  6:addr=
  1845. fast_wind(top,addr,z%)
  1846. )    
  1847.  7:addr=
  1848. fast_wind(top,addr,-z%)
  1849. key_select(z%)
  1850. key_select(-z%)
  1851. subfile(z%)
  1852. subfile(-z%)
  1853. -    
  1854. rotate:addr=
  1855. moveto(key%,top,1)
  1856. "    
  1857. allow_search(wi%,z%)
  1858. display(key%,-1)
  1859. #    
  1860.  15:addr=
  1861. shift(z%,key%,0)
  1862. (-3) 
  1863. *      addr=
  1864. find("#"+
  1865. (REC%),key%,0,
  1866.       
  1867. display(key%,addr)
  1868.         
  1869. $    
  1870.  16:addr=
  1871. shift(-z%,key%,0)
  1872. (-3) 
  1873. *      addr=
  1874. find("#"+
  1875. (REC%),key%,0,
  1876.       
  1877. display(key%,addr)
  1878.         
  1879. 6    
  1880.  17:addr=
  1881. shift(0,key%,1):
  1882. display(key%,addr)
  1883. val_help
  1884. 6    
  1885. check_change:
  1886. save_keys:
  1887. save_all_tables
  1888. store
  1889. retrieve
  1890. !    
  1891. filter(keypadW%,22)
  1892.     S$=$
  1893. text(keypadW%,27)
  1894. #    
  1895.  chartype%(KF%(key%,0)) 
  1896.       
  1897.  5,50,51:
  1898. ?      
  1899. check_date(S$,1,date$)=
  1900. reverse_date(date$)
  1901.         
  1902. 6    
  1903.  S$<>"" 
  1904.  addr=
  1905. find(
  1906. S$,KL%(key%)),key%,1,
  1907.  z%=1 
  1908. !      
  1909. selected(passW%,9) 
  1910. =        !block%=keypadW%:
  1911.  "Wimp_GetWindowState",,block%
  1912. 9        block%!12=block%!4+660:block%!16=block%!8+328
  1913. #        block%!20=0:block%!24=0
  1914. (        
  1915.  "Wimp_OpenWindow",,block%
  1916. %        
  1917. close_window(keypadW%)
  1918.       
  1919.         
  1920. #    
  1921. text(keypadW%,29)<>"" 
  1922. D      Filter$=
  1923. parse($
  1924. text(keypadW%,29),
  1925. selected(keypadW%,32))
  1926.       filter%=
  1927. #      addr=
  1928. moveto(key%,top,z%)
  1929.       
  1930.  filter%=
  1931.         
  1932. !    
  1933. commoncase(wi%,ic%)
  1934. H    
  1935.  "OS_Byte",202,0,239:
  1936. show_menu(specmenu%,oldx%+32,oldy%)
  1937. $    
  1938. open_window(specialW%)
  1939. scan(z%,s%)
  1940. stop%=
  1941.    addr=
  1942. moveto(key%,addr,z%)
  1943.   K%=
  1944.  stop%
  1945. store
  1946.  wi%,ic%
  1947.  "Wimp_GetCaretPosition",,block%
  1948. wi%=!block%:ic%=block%!4
  1949.  wi%=mainW% 
  1950.  scratchpad$=$
  1951. text(wi%,ic%)
  1952. retrieve
  1953.  wi%,ic%,field%
  1954.  "Wimp_GetCaretPosition",,block%
  1955. wi%=!block%:ic%=block%!4
  1956.  scratchpad$<>"" 
  1957.  wi%=mainW% 
  1958.   field%=
  1959. get_field(ic%)
  1960. text(wi%,ic%)=
  1961. scratchpad$,len%(field%))
  1962. redraw_icon(wi%,ic%)
  1963.  ### Binary Large Objects (B.L.O.B.s) ###
  1964. blob_path(create%,f$,R%,F%,V%,
  1965.  O$,main$,level1$,level2$,d%,L%
  1966.  36,39:O$=".Memo"
  1967.  37,40:O$=".Sprite"
  1968.  38:O$=".Draw"
  1969. main$=f$+O$+
  1970. "level1$=main$+"."+
  1971.  4900)
  1972. "level2$=level1$+"."+
  1973. b$=level2$+"."+
  1974.  "OS_File",5,b$ 
  1975.  d%,,,,L%
  1976.  d%=0 
  1977.  create%=
  1978.  "OS_File",8,main$
  1979.  "OS_File",8,level1$
  1980.  "OS_File",8,level2$
  1981.  d%=1 
  1982. load_blob(f$,R%,F%,V%)
  1983.  L%,b$
  1984. blob_path(
  1985. ,f$,R%,F%,V%,b$)
  1986.  L%>=0 
  1987. extend_named_sliding_block(tempanchor%,L%+1)
  1988.  "OS_File",255,b$,!tempanchor%
  1989. blob_to_file(F,L%)
  1990.  L%>0 
  1991.  "OS_GBPB",2,F,!tempanchor%,L%
  1992. copy_blob(source$,dest$,RS%,RD%,FS%,FD%,V%)
  1993.  L%,Z%,bs$,bd$
  1994. ,+L%=
  1995. blob_path(
  1996. ,source$,RS%,FS%,V%,bs$)
  1997.  L%>0 
  1998. .+  Z%=
  1999. blob_path(
  2000. ,dest$,RD%,FD%,V%,bd$)
  2001.  "OS_CLI","Copy "+bs$+" "+bd$+" ~C~V~Q"
  2002. delete_blob(F%,F$,wi%,ic%)
  2003.  flag%
  2004.  delwarn%=
  2005.  "OS_CLI","Delete "+F$:flag%=
  2006. confirm("Delete object? Are you sure?") 
  2007. 8(    
  2008.  "OS_CLI","Delete "+F$:flag%=
  2009.  flag% 
  2010.  chartype%(F%) 
  2011. =)    
  2012.  36:$
  2013. val(wi%,ic%)="Z0;Ssm!edit"
  2014. >*    
  2015.  37:$
  2016. val(wi%,ic%)="Z0;Ssm!paint"
  2017. ?)    
  2018.  38:$
  2019. val(wi%,ic%)="Z0;Ssm!draw"
  2020.  39:$
  2021. text(wi%,ic%)=""
  2022. redraw_icon(wi%,ic%)
  2023. set_blob_sprite(R%,F%,V%)
  2024.  L%,b$,sprite$
  2025.  R%=RA% 
  2026.  L%=-1 
  2027. blob_path(
  2028. ,$database%,R%,F%,V%,b$)
  2029.  L%>=0 
  2030.  sprite$="small_fff" 
  2031.  sprite$="sm!edit"
  2032.  L%>=0 
  2033.  sprite$="small_ff9" 
  2034.  sprite$="sm!paint"
  2035.  L%>=0 
  2036.  sprite$="small_aff" 
  2037.  sprite$="sm!draw"
  2038. val(mainW%,field%(F%))="Z0;Pptr_ext,8,4;S"+sprite$
  2039. redraw_icon(mainW%,field%(F%))
  2040. edit_blob(R%,F%,V%)
  2041.  wi%,ic%,b$,O$,val$
  2042.  R%=RA% 
  2043. check_change:
  2044.  REC%<>RA% 
  2045.  R%=REC%
  2046. wi%=mainW%:ic%=field%(F%)
  2047.  36:O$="Memo":val$="Z0;Ssmall_fff":ftype%=&fff
  2048.  37:O$="Sprite":val$="Z0;Ssmall_ff9":ftype%=&ff9
  2049.  38:O$="Draw":val$="Z0;Ssmall_aff":ftype%=&aff
  2050. blob_path(
  2051. ,$database%,R%,F%,V%,b$)<0 
  2052. val(wi%,ic%)=val$
  2053.  "OS_CLI","Copy <PBase$Dir>.Resources.Objects."+O$+" "+b$+" ~C~V"
  2054. redraw_icon(wi%,ic%)
  2055. `4block%!0=256:block%!12=0:block%!16=5:block%!20=0
  2056. a3block%!24=0:block%!28=0:block%!32=0:block%!36=0
  2057. b)block%!40=ftype%:$(block%+44)=b$+
  2058.  "Wimp_SendMessage",18,block%,0
  2059. transfer_blob(wi%,ic%,R%,file$,ft%)
  2060.  F%,V%,L%,W%,b$
  2061.  wi%<>mainW% 
  2062.  R%=RA% 
  2063. check_change:
  2064.  REC%<>RA% 
  2065.  R%=REC%
  2066. j#F%=(ic%+1) 
  2067.  2:V%=chartype%(F%)
  2068.  ft%=-1 
  2069.  link$(F%)="@"+file$:link$(0)="LOADED"
  2070.  ft%=&fff 
  2071. install_blob:$
  2072. val(wi%,ic%)="Z0;Ssmall_fff"
  2073.  ft%=&ff9 
  2074. install_blob:$
  2075. val(wi%,ic%)="Z0;Ssmall_ff9"
  2076.  ft%=&aff 
  2077. install_blob:$
  2078. val(wi%,ic%)="Z0;Ssmall_aff"
  2079.  ft%=&fff 
  2080. install_blob:
  2081. show_text_block(F%)
  2082.  ft%=&ff9 
  2083. install_blob:
  2084. show_picture(F%)
  2085. redraw_icon(wi%,ic%)
  2086. install_blob
  2087. |+L%=
  2088. blob_path(
  2089. ,$database%,R%,F%,V%,b$)
  2090.  "OS_CLI","Remove "+b$
  2091.  "OS_CLI","Copy "+file$+" "+b$+" ~C~V"
  2092. show_text_block(F%)
  2093.  F,b$,I%,L%,base%
  2094.  F%=0 
  2095. base%=Rf%(F%)
  2096. blob_path(
  2097. ,$database%,REC%,F%,39,b$)
  2098.  L%>0 
  2099.  L%>len%(F%) 
  2100.  L%=len%(F%)
  2101.  ### Load only as much of file as we can display ###
  2102. >  F=
  2103. (b$):
  2104.  F>0 
  2105.  "OS_GBPB",4,F,base%,L%:
  2106. close_file(F)
  2107.  ### Replace any characters<32 by spaces - but ONLY for display ###
  2108.  I%=0 
  2109.  L%-1
  2110. #    
  2111.  base%?I%<32 
  2112.  base%?I%=32
  2113.   base%?L%=10
  2114.  $base%=""
  2115. show_picture(F%)
  2116.  F,f$,I%,max%,len%,x%,y%,w%,h%
  2117.  F%=0 
  2118. /len%=
  2119. blob_path(
  2120. ,$database%,REC%,F%,40,f$)
  2121. E!block%=mainW%:block%!4=field%(F%):
  2122.  "Wimp_GetIconState",,block%
  2123. <x%=block%!8:y%=block%!12:w%=block%!16-x%:h%=block%!20-y%
  2124.  "Wimp_DeleteIcon",,block%
  2125.  len%>=0 
  2126. extend_named_sliding_block(Rf%(F%),len%+4):base%=!Rf%(F%)
  2127. /  !base%=len%+4:
  2128.  "OS_File",255,f$,base%+4
  2129. O  field%(F%)=
  2130. create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",base%+16,base%,0)
  2131. K  field%(F%)=
  2132. create_icon(mainW%,x%,y%,w%,h%,&0700A53E,"",paint%,1,384)
  2133. filter(wi%,ic%)
  2134.  h%,ox%,oy%
  2135.  wi% 
  2136.  keypadW%:h%=530:ox%=0:oy%=0
  2137.  mainW%:h%=200:ox%=0:oy%=-330
  2138. selected(wi%,ic%) 
  2139. 7  !block%=keypadW%:
  2140.  "Wimp_GetWindowState",,block%
  2141. 2  block%!12=block%!4+660:block%!8=block%!16-h%
  2142. !  block%!20=ox%:block%!24=oy%
  2143.  "Wimp_OpenWindow",,block%
  2144.  common% 
  2145. text(keypadW%,29)=""
  2146. set_caret(keypadW%,29)
  2147. text(keypadW%,29)<>"" 
  2148. B    Filter$=
  2149. parse($
  2150. text(keypadW%,29),
  2151. selected(keypadW%,32))
  2152.     filter%=
  2153. !    addr=
  2154. moveto(key%,top,z%)
  2155.  filter%=
  2156.  wi%=keypadW% 
  2157. 9    !block%=keypadW%:
  2158.  "Wimp_GetWindowState",,block%
  2159. 5    block%!12=block%!4+660:block%!8=block%!16-330
  2160.     block%!20=0:block%!24=0
  2161. $    
  2162.  "Wimp_OpenWindow",,block%
  2163. !    
  2164. close_window(keypadW%)
  2165.   filter%=
  2166. fast_wind(T%,P%,D%)
  2167.  fast%=
  2168. text(keypadW%,23))
  2169. D%=(D%+1) 
  2170.  P%<>T% 
  2171.  I%<fast%
  2172.  filter% 
  2173. next_match(P%,D%,Filter$) 
  2174. neighbour(key%,P%,D%)
  2175.   I%+=1
  2176.  P%=T% 
  2177.  filter% 
  2178.  7:P%=
  2179. neighbour(key%,P%,1-D%)
  2180. display(key%,P%)
  2181. subfile(dir%)
  2182. file%+=dir%
  2183.  file%=6 
  2184.  file%=0
  2185.  file%=-1 
  2186.  file%=5
  2187. top=8*file%+LH%
  2188. addr=
  2189. moveto(key%,top,1)
  2190. allow_search(wi%,e%)
  2191.  w%,ox%,oy%
  2192. select(keypadW%,24):
  2193. deselect(keypadW%,25)
  2194. select(keypadW%,25):
  2195. deselect(keypadW%,24)
  2196. deselect(keypadW%,22)
  2197.  buttonfield%(22)>0 
  2198. deselect(mainW%,field%(buttonfield%(22)))
  2199. filter%=
  2200. text(keypadW%,27)="":$
  2201. text(keypadW%,36)=""
  2202. text(keypadW%,33)=Index$(key%)
  2203.  wi% 
  2204.  keypadW%:w%=1000:ox%=0:oy%=0
  2205.  mainW%:w%=340:ox%=660:oy%=0
  2206. 5!block%=keypadW%:
  2207.  "Wimp_GetWindowState",,block%
  2208. 0block%!12=block%!4+w%:block%!8=block%!16-328
  2209. block%!20=ox%:block%!24=oy%
  2210.  "Wimp_OpenWindow",,block%
  2211. set_caret(keypadW%,27)
  2212. val_help
  2213.  name$
  2214.  Fieldnumber%>0 
  2215. !  name$=
  2216. link$(Fieldnumber%))
  2217. (name$)<58 
  2218. (name$)<>-1 
  2219.  name$=
  2220. name$,2)
  2221. '  Tablenumber%=
  2222. table_number(name$)
  2223.  Tablenumber%<>-1 
  2224. show_table(Tablenumber%)
  2225. val_on_off
  2226. validate%=
  2227.  validate%
  2228. tick(menu%(2),3,validate%)
  2229.  validate% 
  2230.  I%=1 
  2231.  vstrings%
  2232.      $valid%(I%)=$rvalid%(I%)
  2233.  I%=1 
  2234.  vstrings%
  2235. $    $valid%(I%)="Pptr_write,4,4"
  2236. save_click(wi%,ic%,b%)
  2237.  p$,H$
  2238. butt%=(b% 
  2239.  %111)
  2240.  wi% 
  2241.  saveW%:
  2242.   Filename$=$SaveName%
  2243.  savefunc$ 
  2244.  "New database":
  2245.     Type%=0
  2246. d    
  2247. Filename$,1)<>"!" 
  2248.  Filename$="!"+Filename$:Filename$=
  2249. Filename$,10):$SaveName%=Filename$
  2250.  "Log changes":
  2251.     Type%=&fff:startlog%=
  2252.  "Save as text":
  2253.     Type%=&fff
  2254. 7    Start%=!textanchor%:End%=Start%+Count%*LenLine%
  2255.     $Start%=pitch$
  2256.  "Save list":
  2257.      Type%=&fff:savetofile%=
  2258.  "Save text":
  2259.     Type%=&fff:
  2260. =    len%=
  2261. blob_path(
  2262. ,$database%,REC%,Fieldnumber%,36,f$)
  2263. 7    
  2264. extend_named_sliding_block(saveanchor%,len%+1)
  2265. (    
  2266.  "OS_File",255,f$,!saveanchor%
  2267. ,    Start%=!saveanchor%:End%=Start%+len%
  2268.  "Save sprite":
  2269.     Type%=&ff9
  2270.  =    len%=
  2271. blob_path(
  2272. ,$database%,REC%,Fieldnumber%,37,f$)
  2273. !7    
  2274. extend_named_sliding_block(saveanchor%,len%+1)
  2275. "(    
  2276.  "OS_File",255,f$,!saveanchor%
  2277. #,    Start%=!saveanchor%:End%=Start%+len%
  2278.  "Save draw":
  2279.     Type%=&aff
  2280. &=    len%=
  2281. blob_path(
  2282. ,$database%,REC%,Fieldnumber%,38,f$)
  2283. '7    
  2284. extend_named_sliding_block(saveanchor%,len%+1)
  2285. ((    
  2286.  "OS_File",255,f$,!saveanchor%
  2287. ),    Start%=!saveanchor%:End%=Start%+len%
  2288.  "Save options":
  2289.     Type%=&7f5
  2290.  "Save query":
  2291. -C    Start%=
  2292. text(matchW%,0):End%=Start%+
  2293. ($Start%)+1:Type%=&7f4
  2294.  "Save selection":
  2295. /1    P%=savebuff%:$P%=printorder$:P%+=
  2296. ($P%)+1
  2297.  T%=0 
  2298.  LastTable%
  2299. 1'     $P%=printrel$(T%):P%+=
  2300. ($P%)+1
  2301. 3>    Start%=savebuff%:End%=Start%+P%-savebuff%+1:Type%=&7F3
  2302.  "Save table":
  2303. 5G    $TabTitle%=
  2304. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  2305. 6D    Start%=!tabanchor%(T%):End%=Start%+160+Rows%*Rec%:Type%=&7f1
  2306.  "Save form file":
  2307.     Type%=&7f2
  2308. lit(menu%(9),3,
  2309. lit(menu%(9),4,
  2310. ;3    
  2311.  adjust%=
  2312. first_field>0 
  2313. default_key
  2314.  savesubW%:
  2315.  savefunc$ 
  2316.  "Export subset":
  2317. @#    Filename$=$SubName%:Type%=0
  2318.  "Export CSV":
  2319. B&    Filename$=$SubName%:Type%=&dfe
  2320.  ic% 
  2321.  (b% 
  2322.  %11110000)>0 
  2323. init_drag(wi%,ic%,5)
  2324. Filename$,".")>0 
  2325. J7    
  2326.  butt%<>2 
  2327. save(Filename$,Type%,Start%,End%)
  2328. K,    
  2329.  butt%=4 
  2330.  "Wimp_CreateMenu",,-1
  2331. softerror("",33)
  2332.  butt%=2 
  2333.  butt%=4 
  2334. show_menu(menu%(15),x%-64,y%-20)
  2335.  butt%=2 
  2336.  butt%=4 
  2337. show_menu(menu%(20),x%-64,y%-20)
  2338. commoncase(wi%,ic%)
  2339. key_click
  2340.  %111 
  2341.  4:z%=1
  2342.  1:z%=-1
  2343.  ic% 
  2344. kcycle(Keyfld0%,F1dkey%,0,z%)
  2345. kcycle(Keyfld0%,F1dkey%,0,-z%)
  2346. kcycle(Keyfld1%,F2dkey%,1,z%)
  2347. kcycle(Keyfld1%,F2dkey%,1,-z%)
  2348. tick_one(fieldmenu%,0,fields%-1,Keyfld0%-1)
  2349. show_menu(fieldmenu%,oldx%+32,oldy%):fieldfunc$="first"
  2350. tick_one(fieldmenu%,0,fields%-1,Keyfld1%-1)
  2351. show_menu(fieldmenu%,oldx%+32,oldy%):fieldfunc$="second"
  2352.  keyfunc$<>"Current key" 
  2353. g/    keylimit%=len%(Keyfld0%)+len%(Keyfld1%)
  2354.  J%=0 
  2355.       WD%(J%)=
  2356. ($Wkey%(J%))
  2357. l1      
  2358. (WD%())>keylimit%:
  2359. softerror("",26)
  2360.       
  2361.       
  2362.  keyfunc$ 
  2363.         
  2364.  "Primary key":
  2365.         key%=0
  2366.         
  2367. copy_keydata(key%)
  2368. r*        RA%=
  2369. ($Records%):f$=$database%
  2370. s&        
  2371. make_empty_index(RA%,0,
  2372. t*        
  2373. save_recs(f$+".Database",RA%)
  2374. u!        present%=7:
  2375. save_keys
  2376. v$        design%=
  2377. get_it_in(f$)
  2378. w0        
  2379.  "New primary key":
  2380. new_tree(file%)
  2381. x)        
  2382.  "Index field":
  2383. create_index
  2384.       
  2385. z        
  2386.   keyfunc$=""
  2387. close_window(keyW%)
  2388. shade_key_icons(on%)
  2389.  I%=16 
  2390. icon_bit(22,keyW%,I%,on%)
  2391.  I%=2 
  2392. icon_bit(22,keyW%,I%,on%)
  2393. kcycle(
  2394.  F%,T%,icon%,z%)
  2395. F%+=z%
  2396.  F%>fields% 
  2397.  F%=0
  2398.  F%<0 
  2399.  F%=fields%
  2400.  F%>0 
  2401.  $T%=Tag$(F%) 
  2402.  $T%=""
  2403. redraw_icon(keyW%,icon%)
  2404. tick_one(fieldmenu%,0,fields%-1,F%-1)
  2405. copy_keydata(key%)
  2406. -KF%(key%,0)=Keyfld0%:KF%(key%,1)=Keyfld1%
  2407. KL%(key%)=
  2408. (WD%())
  2409.  J%=0 
  2410.   KW%(key%,J%)=WD%(J%)
  2411. #case%(key%)=
  2412. selected(keyW%,20)
  2413. set_keydata(key%)
  2414.  J%,S$
  2415. -Keyfld0%=KF%(key%,0):Keyfld1%=KF%(key%,1)
  2416. $F1dkey%=Tag$(Keyfld0%)
  2417.  KF%(key%,1)>0 
  2418.  $F2dkey%=Tag$(Keyfld1%) 
  2419.  $F2dkey%=""
  2420. keylen%=KL%(key%)
  2421.  J%=0 
  2422. 0  WD%(J%)=KW%(key%,J%):$Wkey%(J%)=
  2423. (WD%(J%))
  2424. $KeyNo%=
  2425. (key%)
  2426. set_icon(keyW%,20,case%(key%))
  2427. key_select(D%)
  2428. colour(key%,2)
  2429.  +1:key%=(key%+1) 
  2430.  (Keys%+1)
  2431.  -1:key%-=1:
  2432.  key%<0 
  2433.  key%=Keys%
  2434. colour(key%,1)
  2435. set_keydata(key%)
  2436. text(keypadW%,33)=Index$(key%):
  2437. redraw_icon(keypadW%,33)
  2438. top=8*file%+LH%
  2439. addr=
  2440. moveto(key%,top,1)
  2441. set_colours
  2442.  ic% 
  2443.  0,1,2,3,4,5,6:
  2444.   col%=ncol%(ic%)
  2445.    fb%=
  2446. selected_esg(colW%,2)
  2447.  fb% 
  2448. #    
  2449.  11:col%=(col% 
  2450.  &F):fb%=1
  2451. (    
  2452.  12:col%=((col%>>4) 
  2453.  &F):fb%=0
  2454.  %111 
  2455. "    col%-=1:
  2456.  col%<0 
  2457.  col%=15
  2458. $    
  2459. dcolour(colW%,ic%,col%,fb%)
  2460.     col%=(col%+1) 
  2461. $    
  2462. dcolour(colW%,ic%,col%,fb%)
  2463. *  ncol%(ic%)=
  2464. get_icon_cols(colW%,ic%)
  2465.  9,10:
  2466.   fcol%()=ncol%()
  2467.  I%=0 
  2468.  Keys%
  2469. colour(I%,2)
  2470. colour(0,0)
  2471. colour(key%,1)
  2472.  I%=1 
  2473.  fields%
  2474. D    
  2475.  link$(I%)<>"" 
  2476. set_icon_cols(mainW%,field%(I%),ncol%(6))
  2477.  ic%=10 
  2478. write_colours
  2479.  "Wimp_CreateMenu",,-1
  2480. read_colours("<Pbase$Dir>.Resources.Colours")
  2481.  I%=0 
  2482. *    
  2483. set_icon_cols(colW%,I%,ncol%(I%))
  2484. create_click
  2485.  Calc$
  2486. butt%=(b% 
  2487.  %111)
  2488.  butt% 
  2489.  2,4:
  2490.  ic%=36 
  2491. show_menu(menu%(menunumber%),oldx%+32,oldy%)
  2492.  butt%=4 
  2493.  z%=1 
  2494.  butt%=1 
  2495.  z%=-1 
  2496.  ic% 
  2497. set_limits(1,0,8,8)
  2498. set_limits(36,36,40,11)
  2499. set_limits(9,9,35,19)
  2500. set_limits(41,41,45,14)
  2501. set_limits(46,46,59,16)
  2502. change_type(z%,menunumber%)
  2503. change_type(-z%,menunumber%)
  2504. create_field(
  2505. ($InsText%),posx%,posy%,Calc$)
  2506. remove_field(Fieldnumber%,
  2507. ,Calc$)
  2508. create_field(Fieldnumber%,posx%,posy%,Calc$)
  2509. remove_field(Fieldnumber%,
  2510. ,Calc$)
  2511. icon_bit(22,createW%,13,(
  2512. selected(createW%,14)))
  2513.   F%=
  2514. ($InsText%)
  2515.  F%>0 
  2516.  F%<=fields% 
  2517. (    
  2518.  F%<Fieldnumber% 
  2519.  Z%=-1 
  2520.  Z%=1
  2521. (    
  2522. re_sequence(Fieldnumber%,F%,Z%)
  2523. close_window(createW%)
  2524. swap_fields(Fieldnumber%,
  2525. ($InsText%))
  2526. update_box
  2527.  (present% 
  2528.  4)=0 
  2529. lit(menu%(9),1,(fields%>0))
  2530.  ic% 
  2531.  18,29,30:
  2532.  butt%=4 
  2533. close_window(createW%)
  2534.         
  2535. #    
  2536. icon_bit(22,createW%,18,
  2537. +    
  2538. icon_bit(22,createW%,30,
  2539.  adjust%)
  2540. #    
  2541. icon_bit(22,createW%,29,
  2542.     Fieldnumber%=fields%
  2543. update_box
  2544.  fieldtype% 
  2545.  0,1,2,3,4,5,6,7,46,47:
  2546.  adjust% 
  2547. icon_bit(22,createW%,6,
  2548. icon_bit(22,createW%,6,
  2549. icon_bit(22,createW%,14,(fieldtype%=3 
  2550.  fieldtype%=6))
  2551. icon_bit(22,createW%,13,(fieldtype%=3 
  2552.  fieldtype%=6) 
  2553. selected(createW%,14))
  2554. icon_bit(22,createW%,15,(fieldtype%=3 
  2555.  fieldtype%=47))
  2556. icon_bit(22,createW%,25,(fieldtype%=3))
  2557. icon_bit(22,createW%,26,
  2558.  adjust%)
  2559.  adjust% 
  2560. lit(menu%(9),2,(fields%>0))
  2561.  $ValText%=vname$(fieldtype%)
  2562. redraw_icon(createW%,28)
  2563. set_limits(t%,f%,l%,m%)
  2564. fieldtype%=t%
  2565. firsttype%=f%
  2566. lasttype%=l%
  2567. menunumber%=m%
  2568. tick_one(menu%(m%),0,l%-f%,t%-f%)
  2569. update_box
  2570. change_type(d%,m%)
  2571.  1:fieldtype%+=1
  2572.  fieldtype%>lasttype% 
  2573.  fieldtype%=firsttype%
  2574.  -1:fieldtype%-=1
  2575.  fieldtype%<firsttype% 
  2576.  fieldtype%=lasttype%
  2577. tick_one(menu%(m%),0,lasttype%-firsttype%,fieldtype%-firsttype%)
  2578. update_box
  2579. passwords
  2580.  ic% 
  2581.  $Write%="" 
  2582.  $Write%=$Read%
  2583.  $Manager%="" 
  2584.  $Manager%=$Write%
  2585. 3   F=
  2586. ($database%+".Colours")
  2587. #F=35
  2588. 5"  S$=
  2589. encrypt($Read%,
  2590. #F,S$
  2591. 6#  S$=
  2592. encrypt($Write%,
  2593. #F,S$
  2594. 7%  S$=
  2595. encrypt($Manager%,
  2596. #F,S$
  2597.  I%=9 
  2598. 9     
  2599. selected(passW%,I%)
  2600. #F,logpath$
  2601. close_file(F)
  2602. lit(menu%(1),6,
  2603. selected(passW%,9))
  2604. lit(menu%(1),7,
  2605. selected(passW%,13))
  2606. lit(menu%(1),8,
  2607. selected(passW%,13))
  2608. lit(menu%(1),2,
  2609. selected(passW%,14))
  2610. lit(menu%(3),8,
  2611. selected(passW%,15))
  2612. selected(passW%,9) 
  2613. close_window(keypadW%) 
  2614. open_window(keypadW%)
  2615. close_window(passW%):
  2616. close_window(saveW%)
  2617.   warn%=
  2618. selected(passW%,16) 
  2619.     savefunc$="Log changes"
  2620. IJ    
  2621.  logpath$="" 
  2622.  $SaveName%=$database%+".Log" 
  2623.  $SaveName%=logpath$
  2624. J2    $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
  2625. K7    !block%=passW%:
  2626.  "Wimp_GetWindowState",,block%
  2627. L*    xmin%=block%!4+200:ymax%=block%!16
  2628. M7    !block%=saveW%:
  2629.  "Wimp_GetWindowState",,block%
  2630. N9    block%!12=xmin%+block%!12-block%!4:block%!4=xmin%
  2631. O9    block%!8=ymax%-block%!16+block%!8:block%!16=ymax%
  2632. P1    block%!28=-1:
  2633.  "Wimp_OpenWindow",,block%
  2634. set_caret(saveW%,0)
  2635. open_log
  2636. close_log
  2637. open_log
  2638.  logpath$<>"" 
  2639.  "OS_File",5,logpath$ 
  2640.  d%=1 
  2641. \8    loghandle%=
  2642. (logpath$):
  2643. #loghandle%=
  2644. #loghandle%
  2645. ]%    
  2646. #loghandle%,"Log opened "+
  2647. ^3    
  2648. #loghandle%,"Password level used: "+
  2649. (pw%)
  2650. #loghandle%,
  2651. 35,"=")
  2652. `        
  2653. softerror("",99)
  2654. deselect(passW%,16)
  2655.     logpath$=""
  2656. close_log
  2657.  loghandle%<>0 
  2658. #loghandle%,""
  2659. #loghandle%,"Log closed "+
  2660. close_file(loghandle%)
  2661.  "OS_File",18,logpath$,&fff
  2662. count(key%,
  2663.  RU%)
  2664.  zero%,file%,top,sum%
  2665. s    RU%=0
  2666.  file%=0 
  2667.   top=8*file%+LH%
  2668. v"  sum%=
  2669. count_recs(key%,zero%)
  2670.   RU%+=sum%
  2671. x%  $
  2672. text(miscW%,file%+22)=
  2673. (sum%)
  2674.  file%
  2675. count_recs(key%,
  2676.  ptr%)
  2677.  P%,count%,S%,R%,S$,k$
  2678.  "Hourglass_On"
  2679. neighbour(key%,top,1)
  2680.  P%<>top
  2681.   count%+=1
  2682.  ptr%>0 
  2683.     R%=
  2684. rec_no(k$,key%,P%)
  2685. #    
  2686.  R%>highest% 
  2687.  highest%=R%
  2688. 1    !ptr%=R%:$(ptr%+4)=k$:ptr%+=4+KL%(key%)+1
  2689.     flagptr%?R%=0
  2690.   P%=
  2691. neighbour(key%,P%,1)
  2692.  "Hourglass_Off"
  2693. =count%
  2694. analyse(func%)
  2695.  L%,P%,S%,S$,K$,k$,ptr%,pos%,N%,values%,key%
  2696.  S$(),N%()
  2697. read_print_options
  2698.  func%<0 
  2699.  L%=6 
  2700.  key%=func%:L%=KL%(key%)
  2701.  L%>8 
  2702.  Tab%(0)=Lmargin%+L%+6 
  2703.  Tab%(0)=Lmargin%+14
  2704. Tab%(1)=Tab%(0)+6
  2705.  func%<0 
  2706. :  Title$="Analysis of date field: "+Tag$(Fieldnumber%)
  2707. 5  Heading$=
  2708. pad(margin$+"Month",Tab%(0))+"Number"
  2709. /  Title$="Analysis of index: "+Index$(key%)
  2710. 8  Heading$=
  2711. pad(margin$+"Contents",Tab%(0))+"Number"
  2712. Title1$=
  2713. LenLine%=
  2714. (Heading$)+2
  2715. extend_named_sliding_block(lineanchor%,LenLine%+4)
  2716. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  2717. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  2718. reportdest$="Window"
  2719. close_window(datadicW%)
  2720. Count%=0
  2721. list_head(0)
  2722.  "Hourglass_On"
  2723.  func%<0 
  2724. analyse_date 
  2725. analyse_index
  2726.  "Hourglass_Off"
  2727. rule_off(45)
  2728. ;Line$=
  2729. pad(margin$+"Total",Tab%(0))+
  2730. justify(
  2731. (N%),1,0)
  2732. @$(!lineanchor%)=Line$:
  2733. list_line(-1,lineanchor%,
  2734. (Line$),32)
  2735. rule_off(45)
  2736. screen_list
  2737. analyse_index
  2738. K$="***"
  2739. neighbour(key%,top,1)
  2740.  P%<>top
  2741.     R%=
  2742. rec_no(k$,key%,P%)
  2743. #    
  2744.  k$<>K$ 
  2745.  values%+=1:K$=k$
  2746.      P%=
  2747. neighbour(key%,P%,1)
  2748.  S$(values%),N%(values%)
  2749. K$="***"
  2750. neighbour(key%,top,1)
  2751.  P%<>top
  2752.     R%=
  2753. rec_no(k$,key%,P%)
  2754. E    
  2755.  k$<>K$ 
  2756.  ptr%+=1:K$=k$:S$(ptr%)=K$:N%(ptr%)=1 
  2757.  N%(ptr%)+=1
  2758.      P%=
  2759. neighbour(key%,P%,1)
  2760.  I%=1 
  2761.  ptr%
  2762. I  S$=S$(I%):
  2763.  S$="" 
  2764.  S$="<null>" 
  2765.  isadate% 
  2766. reverse_date(S$)
  2767. H  Line$=margin$+S$:Line$=
  2768. pad(Line$,Tab%(0))+
  2769. justify(
  2770. (N%(I%)),1,0)
  2771. B  $(!lineanchor%)=Line$:
  2772. list_line(-1,lineanchor%,
  2773. (Line$),32)
  2774.   N%+=N%(I%)
  2775. analyse_date
  2776.  S$(12),N%(12)
  2777. YS$()="<null>","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec"
  2778. *dbasehandle%=
  2779. ($database%+".Database")
  2780. neighbour(key%,top,1)
  2781.  P%<>top
  2782.   R%=
  2783. rec_no(k$,key%,P%)
  2784. readsmarray(dbasehandle%,R%)
  2785.   S$=F$(Fieldnumber%)
  2786.  S$<>"" 
  2787.     M%=
  2788. S$,4,2))
  2789.     N%(M%)+=1
  2790.  N%(0)+=1
  2791.   P%=
  2792. neighbour(key%,P%,1)
  2793. close_file(dbasehandle%)
  2794.  I%=0 
  2795. L  Line$=margin$+S$(I%):Line$=
  2796. pad(Line$,Tab%(0))+
  2797. justify(
  2798. (N%(I%)),1,0)
  2799. B  $(!lineanchor%)=Line$:
  2800. list_line(-1,lineanchor%,
  2801. (Line$),32)
  2802.   N%+=N%(I%)
  2803. update_stats
  2804. $filesize%=
  2805. (RA%)
  2806. $Records%=
  2807. (RA%)
  2808. $used%=
  2809. (RU%)
  2810. #$percent%=
  2811. (RU%*100/RA%))+"%"
  2812.  Keypress processing --------------------------------------------------
  2813. set_keyboard(wi%,ic%)
  2814.  wi% 
  2815.  mainW%:
  2816.  chartype%((ic%+1) 
  2817. $    
  2818.  2,4:
  2819.  "OS_Byte",202,0,239
  2820. !    
  2821.  "OS_Byte",202,16,111
  2822.  "OS_Byte",202,caps%,111
  2823.  "OS_Byte",118
  2824. process_key
  2825.  printing% 
  2826.  indexing% 
  2827.  T%,N$
  2828.  "Wimp_GetCaretPosition",,block%
  2829. 4wi%=block%!0:ic%=block%!4:key_pressed%=block%!24
  2830.  wi% 
  2831.  mainW%:
  2832. main_press
  2833.  keypadW%:
  2834. keypad_press
  2835.  passW%:
  2836. dbox_press(4)
  2837.  changeW%:
  2838. dbox_press(4)
  2839.  tableW%:
  2840. dbox_press(26)
  2841.  saveW%:
  2842. dbox_press(2)
  2843.  datadicW%:
  2844. datadic_press
  2845.  printW%:
  2846. dbox_press(20)
  2847.  labelW%:
  2848. dbox_press(15)
  2849.  createW%:
  2850. create_press
  2851.  accessW%:
  2852. dbox_press(3)
  2853.  keyW%:
  2854. dbox_press(7)
  2855.  savesubW%:
  2856. dbox_press(2)
  2857.  matchW%:
  2858. match_press
  2859.  moveW%:
  2860. dbox_press(8)
  2861.  calcW%:
  2862. dbox_press(1)
  2863.  mergeW%:
  2864. dbox_press(7)
  2865.  sizeW%:
  2866. dbox_press(4)
  2867.  csvW%:
  2868. dbox_press(9)
  2869. keypad_press
  2870.  key_pressed%=13 
  2871.  ic% 
  2872. !    
  2873. mouse(0,0,4,wi%,28)
  2874. !    
  2875. mouse(0,0,4,wi%,30)
  2876.  "Wimp_ProcessKey",key_pressed%
  2877. main_press
  2878. selected(passW%,10) 
  2879.  "Wimp_ProcessKey",key_pressed%:
  2880.  icon%
  2881.  flash% 
  2882. deselect(mainW%,field%(flash%)):flash%=
  2883.  key_pressed%<>392 
  2884. validate(Fieldnumber%,T%,N$)=
  2885. update_calcs(Fieldnumber%)
  2886.  key_pressed% 
  2887.  wi% 
  2888.  mainW%:
  2889.     ""      
  2890.  Fieldnumber%=fields% 
  2891.     ##        
  2892. close_window(relateW%)
  2893.         
  2894. display(key%,-1)
  2895.         
  2896.         
  2897.     'E          Fieldnumber%+=1:
  2898.  Fieldnumber%>fields% 
  2899.  Fieldnumber%=1
  2900.     ((          c%=chartype%(Fieldnumber%)
  2901.     )2        
  2902.  len%(Fieldnumber%)>0 
  2903.  (c%<6 
  2904.  c%=8)
  2905.     *&        icon%=field%(Fieldnumber%)
  2906.     +$        
  2907. set_caret(mainW%,icon%)
  2908.     ,*        
  2909.  relations%=
  2910. relations(
  2911.       
  2912.  398:
  2913.     1?    Fieldnumber%+=1:
  2914.  Fieldnumber%>fields% 
  2915.  Fieldnumber%=1
  2916.     2"    c%=chartype%(Fieldnumber%)
  2917.     3,  
  2918.  len%(Fieldnumber%)>0 
  2919.  (c%<6 
  2920.  c%=8)
  2921.     4   icon%=field%(Fieldnumber%)
  2922. set_caret(mainW%,icon%)
  2923.     6$  
  2924.  relations%=
  2925. relations(
  2926.  399:
  2927.     9?    Fieldnumber%-=1:
  2928.  Fieldnumber%<1 
  2929.  Fieldnumber%=fields%
  2930.     :"    c%=chartype%(Fieldnumber%)
  2931.     ;,  
  2932.  len%(Fieldnumber%)>0 
  2933.  (c%<6 
  2934.  c%=8)
  2935.     <   icon%=field%(Fieldnumber%)
  2936. set_caret(mainW%,icon%)
  2937.     >$  
  2938.  relations%=
  2939. relations(
  2940.     ?4  
  2941.  389:
  2942.  Access% 
  2943. show_menu(changeW%,500,600)
  2944.  405:
  2945. (printorder$)=2 
  2946.     BB    Fieldnumber%=
  2947. fnum(printorder$):V%=chartype%(Fieldnumber%)
  2948.       
  2949.  36,39:
  2950.     EF      
  2951. blob_path(
  2952. ,$database%,REC%,Fieldnumber%,V%,object$)>=0 
  2953.         
  2954. set_up_field_menu
  2955.     G&        
  2956. show_menu(saveW%,500,600)
  2957.       
  2958.     I        
  2959.  408:
  2960. val_on_off
  2961.     L$  
  2962.  387:
  2963. mouse(0,0,4,keypadW%,2)
  2964.     M$  
  2965.  403:
  2966. mouse(0,0,4,keypadW%,3)
  2967.     N$  
  2968.  386:
  2969. mouse(0,0,4,keypadW%,4)
  2970.     O$  
  2971.  402:
  2972. mouse(0,0,4,keypadW%,5)
  2973.     P$  
  2974.  391:
  2975. mouse(0,0,4,keypadW%,6)
  2976.     Q$  
  2977.  407:
  2978. mouse(0,0,4,keypadW%,7)
  2979.     R$  
  2980.  393:
  2981. mouse(0,0,4,keypadW%,8)
  2982.     S$  
  2983.  409:
  2984. mouse(0,0,4,keypadW%,9)
  2985.     T%  
  2986.  388:
  2987. mouse(0,0,4,keypadW%,10)
  2988.     U%  
  2989.  404:
  2990. mouse(0,0,4,keypadW%,11)
  2991.     V%  
  2992.  420:
  2993. mouse(0,0,4,keypadW%,12)
  2994.     W%  
  2995.  385:
  2996. mouse(0,0,4,keypadW%,13)
  2997.     X%  
  2998.  401:
  2999. mouse(0,0,1,keypadW%,13)
  3000.     Y%  
  3001.  458:
  3002. mouse(0,0,4,keypadW%,14)
  3003.     Z%  
  3004.  390:
  3005. mouse(0,0,4,keypadW%,15)
  3006.     [%  
  3007.  406:
  3008. mouse(0,0,4,keypadW%,16)
  3009.     \%  
  3010.  422:
  3011. mouse(0,0,4,keypadW%,17)
  3012.     ]%  
  3013.  392:
  3014. mouse(0,0,4,keypadW%,18)
  3015.  384:
  3016. print_this
  3017.  400:
  3018. match
  3019.     `!  
  3020.  416:
  3021. open_window(printW%)
  3022.     a)  
  3023.  "Wimp_ProcessKey",key_pressed%
  3024.  chartype%(Fieldnumber%) 
  3025.     d"  
  3026.  2,4:
  3027.  "OS_Byte",202,0,239
  3028.  "OS_Byte",202,16,111
  3029.  "OS_Byte",118
  3030.  "OS_Byte",15,0
  3031. dbox_press(ok%)
  3032.  key_pressed% 
  3033.     mC  
  3034. next_writeable(wi%,ic%,1,1)=
  3035. mouse(0,0,4,wi%,ok%)
  3036.     n3  
  3037. close_window(wi%):
  3038. set_caret(mainW%,-1)
  3039.     o+  
  3040.  398:f%=
  3041. next_writeable(wi%,ic%,1,0)
  3042.     p,  
  3043.  399:f%=
  3044. next_writeable(wi%,ic%,-1,0)
  3045.     q)  
  3046.  "Wimp_ProcessKey",key_pressed%
  3047. datadic_press
  3048.  icons%
  3049. icons%=Rows%*(TabFields%+1)
  3050.  key_pressed% 
  3051.     z2  
  3052.  ic%<icons%-1 
  3053. set_caret(datadicW%,ic%+1)
  3054.  398:
  3055.     |H  
  3056.  ic%<icons%-TabFields%-1 
  3057. set_caret(datadicW%,ic%+TabFields%+1)
  3058.  399:
  3059.     ~B  
  3060.  ic%>=TabFields%+1 
  3061. set_caret(datadicW%,ic%-TabFields%-1)
  3062.  "Wimp_ProcessKey",key_pressed%
  3063. create_press
  3064. shaded(wi%,29):
  3065. shaded(wi%,18) 
  3066. dbox_press(18)
  3067. shaded(wi%,29) 
  3068. dbox_press(29)
  3069. match_press
  3070.  key_pressed% 
  3071. mouse(0,0,4,matchW%,1)
  3072. close_window(matchW%):
  3073.  "Wimp_SetCaretPosition",mainW%,-1
  3074.  384:
  3075. print_this
  3076.  "Wimp_ProcessKey",key_pressed%
  3077. menu_select
  3078.  handle%,P%,Q%,I%
  3079. &choice1%=!block%:choice2%=block%!4
  3080. (choice3%=block%!8:choice4%=block%!12
  3081.  "Wimp_DecodeMenu",,menuhandle%,block%,choices%
  3082.  I%=1 
  3083.   Q%=
  3084. $choices%,".",P%+1)
  3085. &  choice$(I%)=
  3086. $choices%,P%,Q%-P%)
  3087.   P%=Q%+1
  3088.  "Wimp_GetPointerInfo",,block%
  3089. redo%=block%!8=1
  3090.  menuhandle% 
  3091.  menu%(0):
  3092.  choice$(1) 
  3093. 8    
  3094.  "Help":
  3095.  "Wimp_StartTask","<Pbase$Dir>.!Help"
  3096. G    
  3097.  "Save choices":
  3098. save_choices("<Pbase$Dir>.Resources.Choices")
  3099. J    
  3100.  "Default choices":
  3101. get_choices("<Pbase$Dir>.Resources.Defaults")
  3102.  "Utilities":
  3103.  choice$(2) 
  3104.       
  3105.  "New primary key":
  3106.       $KeyTitle%=choice$(2)
  3107. -      keyfunc$=choice$(2):
  3108. set_keydata(0)
  3109.       
  3110. shade_key_icons(
  3111.       
  3112.  (present% 
  3113.  2)=2 
  3114. /        
  3115. select(keyW%,8):
  3116. deselect(keyW%,9)
  3117. ;        
  3118. icon_bit(22,keyW%,8,
  3119. icon_bit(22,keyW%,9,
  3120.         
  3121. /        
  3122. select(keyW%,9):
  3123. deselect(keyW%,8)
  3124. ;        
  3125. icon_bit(22,keyW%,8,
  3126. icon_bit(22,keyW%,9,
  3127.       
  3128. 4      
  3129. set_height(keyW%,700):
  3130. set_caret(keyW%,2)
  3131.        
  3132.  "New record format":
  3133. !      
  3134. close_window(reformW%)
  3135.        
  3136. confirm(
  3137. msg(28)) 
  3138.         reform$="Reformat"
  3139. .        $RefmTitle%="Change record format"
  3140. %        
  3141. set_height(reformW%,220)
  3142.       
  3143.       
  3144.  "Adjust format":
  3145.       
  3146. adjust_on(
  3147.       
  3148. display(key%,-1)
  3149. 5      
  3150. alter_flags(&17016731,&07006535,&1700653B)
  3151.       
  3152.  "Merge database":
  3153. !      
  3154. close_window(reformW%)
  3155.       reform$="Merge"
  3156. &      $RefmTitle%="Merge database"
  3157. #      
  3158. set_height(reformW%,360)
  3159.       
  3160.  "Balance index":
  3161.       
  3162.  choice$(3) 
  3163.         
  3164.  "Automatic":
  3165.         
  3166.  choice4%=0 
  3167. !          
  3168. set_autobalance(
  3169. 8          
  3170. set_autobalance(
  3171. ticked(menu%(21),0))
  3172.         
  3173. (        
  3174.  "Right now":
  3175. balance(key%)
  3176.       
  3177.       
  3178.  "Print index":
  3179.       
  3180.  choice$(3) 
  3181.         
  3182.  "Complete":
  3183. )        
  3184. print_tree(key%,file%,"ALL")
  3185.         
  3186.  "Totals only":
  3187. ,        
  3188. print_tree(key%,file%,"TOTALS")
  3189.       
  3190. 5      
  3191.  "Find duplicates":
  3192. duplicates(key%,file%)
  3193. C      
  3194.  "Warn of duplicates":dup%=
  3195.  dup%:
  3196. tick(menu%(3),8,dup%)
  3197.         
  3198.      
  3199.  "Close database":
  3200.  "Quit":quit%=
  3201.  menu%(1):
  3202.  choice$(1) 
  3203.  "CSV options"
  3204.     $CSVTitle%=choice$(1)
  3205. icon_bit(22,csvW%,0,
  3206. 6    !block%=csvW%:
  3207.  "Wimp_GetWindowState",,block%
  3208. -    block%!4=oldx%:block%!12=block%!4+390
  3209. 8    block%!8=200:block%!16=block%!8+420:block%!28=-1
  3210. $    
  3211.  "Wimp_OpenWindow",,block%
  3212.  "Miscellaneous":
  3213.  choice$(2) 
  3214. 0      
  3215.  "Set passwords":
  3216. open_window(passW%)
  3217. 9      
  3218.  "Edit template":template%=1:
  3219. display(key%,-1)
  3220. 0      
  3221.  "Save indices":
  3222. set_auto(2-choice3%)
  3223.         
  3224.  "Current key":
  3225. 1    $KeyTitle%=choice$(1):keyfunc$=choice$(1)
  3226. set_keydata(key%)
  3227. 2    
  3228. shade_key_icons(
  3229. set_height(keyW%,590)
  3230.  "Print":
  3231.  choice$(2) 
  3232.       
  3233.  "Match":
  3234. match
  3235. '      
  3236.  "Show resources":*Resources
  3237. B      
  3238.  "Options":
  3239. open_window(printW%):
  3240. set_caret(printW%,16)
  3241.       
  3242.  "Save options":
  3243. 5      $SaveName%=$database%+".PrintRes.PrintOpts"
  3244. 6      savefunc$=choice$(2):
  3245. save_click(saveW%,2,4)
  3246.       
  3247.  "Save query":
  3248. 1      $SaveName%=$database%+".PrintRes.Query"
  3249. 6      savefunc$=choice$(2):
  3250. save_click(saveW%,2,4)
  3251.       
  3252.  "Save selection":
  3253. 5      $SaveName%=$database%+".PrintRes.Selection"
  3254. 6      savefunc$=choice$(2):
  3255. save_click(saveW%,2,4)
  3256. &      
  3257.  "Show jobs done":*JobsDone
  3258. .      
  3259.  "Clear selection":
  3260. clear_selection
  3261. $      
  3262.  "Select all":
  3263. select_all
  3264.       
  3265. match
  3266.         
  3267.  "Validation":
  3268.  choice$(2) 
  3269. F      
  3270.  "Create table":
  3271. open_window(tableW%):
  3272. set_caret(tableW%,0)
  3273.       
  3274.  "Display table":
  3275.       
  3276.  choice3%>=0 
  3277. !        Tablenumber%=choice3%
  3278. %        
  3279. show_table(Tablenumber%)
  3280.       
  3281. &      
  3282.  "Show table files":*Tables
  3283.     (      
  3284.  "Validate input":
  3285. val_on_off
  3286. Q      
  3287.  "Show relations":relations%=
  3288.  relations%:
  3289. tick(menu%(2),4,relations%)
  3290.         
  3291. F    
  3292.  "Show keypad":
  3293. selected(passW%,9) 
  3294. open_window(keypadW%)
  3295. =    
  3296.  "Save choices":
  3297. save_choices($database%+".Choices")
  3298. %    
  3299.  "Undo changes":
  3300. restore_rec
  3301. 8    
  3302.  "Help":
  3303.  "Wimp_StartTask","<Pbase$Dir>.!Help"
  3304.  choice$(2) 
  3305.       
  3306.  "Index field":
  3307. 3      $KeyTitle%=choice$(2):keyfunc$=choice$(2)
  3308. 1      
  3309. deselect(keyW%,20):
  3310. shade_key_icons(
  3311. 4      
  3312. set_height(keyW%,590):
  3313. set_caret(keyW%,2)
  3314. =      
  3315.  "Analyse index":
  3316. analyse(
  3317. is_a_key(Fieldnumber%))
  3318. )      
  3319.  "Analyse months":
  3320. analyse(-1)
  3321. 0      
  3322.  "Link to table":
  3323. open_window(linkW%)
  3324.       
  3325.  "Start editing":
  3326. )      starthere%=field%(Fieldnumber%)
  3327. 3      
  3328.  Access% 
  3329. set_caret(mainW%,starthere%)
  3330. [      
  3331.  "Clear contents":
  3332. delete_blob(Fieldnumber%,object$,mainW%,field%(Fieldnumber%))
  3333. (      
  3334.  chartype%(Fieldnumber%)=40 
  3335. Q        
  3336. show_picture(Fieldnumber%):
  3337. redraw_icon(mainW%,field%(Fieldnumber%))
  3338.       
  3339.  0      
  3340.  "Warn of delete":delwarn%=
  3341.  delwarn%
  3342. !%      
  3343. tick(menu%(10),7,delwarn%)
  3344. "7      
  3345.  "Undo changes":
  3346. restore(Fieldnumber%,"",-1)
  3347. #        
  3348.  menu%(9):
  3349.  choice$(1) 
  3350. 'F    
  3351.  "Design field":
  3352. open_window(createW%):
  3353. set_caret(createW%,4)
  3354.  "Save form file":
  3355. )%    $SaveName%=$database%+".Form"
  3356. *4    savefunc$=choice$(1):
  3357. save_click(saveW%,2,4)
  3358.  "Default database":
  3359. ,&    
  3360. save_form($database%+".Form")
  3361. get_it_in($database%)
  3362. first_field>0 
  3363.       
  3364. default_key
  3365. 0%      
  3366. defaults($database%,100,0)
  3367.       
  3368. softerror("",35)
  3369. 2        
  3370.  "Primary key":
  3371.     $KeyTitle%=choice$(1)
  3372.     keyfunc$=choice$(1)
  3373. 6"    case%(0)=
  3374. set_keydata(0)
  3375. 70    
  3376. deselect(keyW%,20):
  3377. shade_key_icons(
  3378. 82    
  3379. set_height(keyW%,590):
  3380. set_caret(keyW%,2)
  3381.  "Quit design":
  3382. adjust_on(
  3383. ;&    
  3384. save_form($database%+".Form")
  3385. get_it_in($database%)
  3386.  menu%(17):
  3387. ?"  T%=
  3388. table_number($menu%(17))
  3389.  choice$(1) 
  3390.  "Save":
  3391. B6    $SaveName%=$database%+".ValTables."+table$(T%)
  3392. C6    savefunc$="Save table":
  3393. save_click(saveW%,2,4)
  3394. D"    
  3395.  "Clear":
  3396. clear_table(T%)
  3397. E"    
  3398.  "Print":
  3399. print_table(T%)
  3400. F     
  3401.  "Sort":
  3402. sort_table(T%)
  3403. G/    
  3404.  "Undo all":
  3405. restore_table(T%,tablen%)
  3406. H)    
  3407.  "Undo change":
  3408. restore_tabfield
  3409.  menu%(18):
  3410.  choice$(1) 
  3411.  "Save as text":
  3412. M/    $SaveName%=$database%+".PrintJobs.List"
  3413. N4    savefunc$=choice$(1):
  3414. save_click(saveW%,2,4)
  3415.  "Sort":
  3416. sort_list
  3417.  "Scrap":
  3418. lose_list
  3419.  menu%(15):
  3420.  choice$(1) 
  3421.  "Comma":sep$=","
  3422.  "TAB":sep$=
  3423.  "CR":sep$=
  3424.  "LF":sep$=
  3425.  sep$=$Delim%
  3426. tick_one(menuhandle%,0,3,choice1%)
  3427. [!  $
  3428. text(csvW%,14)=choice$(1)
  3429. redraw_icon(csvW%,14)
  3430.  menu%(20):
  3431.  choice$(1) 
  3432.  "CR":term$=
  3433.  "LF":term$=
  3434. a#    
  3435.  "CR LF":term$=
  3436. (13)+
  3437. b#    
  3438.  "LF CR":term$=
  3439. (10)+
  3440. c#    
  3441.  "CR CR":term$=
  3442. (13)+
  3443. d#    
  3444.  "LF LF":term$=
  3445. (10)+
  3446. :term$=$Termin%
  3447. tick_one(menuhandle%,0,5,choice1%)
  3448. h!  $
  3449. text(csvW%,15)=choice$(1)
  3450. redraw_icon(csvW%,15)
  3451.  menu%(8),menu%(11),menu%(14),menu%(16),menu%(19):
  3452. k$  fieldtype%=firsttype%+choice1%
  3453. tick_one(menuhandle%,0,lasttype%-firsttype%,choice1%)
  3454. update_box
  3455.  menu%(5):
  3456.   Tablenumber%=choice1%
  3457. p&  $Tablename%=table$(Tablenumber%)
  3458. tick_one(menuhandle%,0,LastTable%,choice1%)
  3459. redraw_icon(linkW%,0)
  3460.  fieldmenu%:
  3461.  fieldfunc$ 
  3462.  "match":
  3463.     Match_tag%=choice1%+1
  3464. wB    $
  3465. text(matchW%,3)=Tag$(Match_tag%):
  3466. redraw_icon(matchW%,3)
  3467. x2    
  3468. tick_one(fieldmenu%,0,fields%-1,choice1%)
  3469.  "first":
  3470. z#    
  3471.  keyfunc$<>"Current key" 
  3472. {*      
  3473. ticked(fieldmenu%,choice1%) 
  3474. |8        Keyfld0%=0:$F1dkey%="":
  3475. redraw_icon(keyW%,0)
  3476. }(        
  3477. tick(fieldmenu%,choice1%,
  3478.         
  3479.         Keyfld0%=choice1%+1
  3480. 9        $F1dkey%=Tag$(Keyfld0%):
  3481. redraw_icon(keyW%,0)
  3482. 6        
  3483. tick_one(fieldmenu%,0,fields%-1,choice1%)
  3484.       
  3485.         
  3486.  "second":
  3487. #    
  3488.  keyfunc$<>"Current key" 
  3489. *      
  3490. ticked(fieldmenu%,choice1%) 
  3491. 8        Keyfld1%=0:$F2dkey%="":
  3492. redraw_icon(keyW%,1)
  3493. (        
  3494. tick(fieldmenu%,choice1%,
  3495.         
  3496.         Keyfld1%=choice1%+1
  3497. 9        $F2dkey%=Tag$(Keyfld1%):
  3498. redraw_icon(keyW%,1)
  3499. 6        
  3500. tick_one(fieldmenu%,0,fields%-1,choice1%)
  3501.       
  3502.         
  3503. special_select
  3504.  quit% 
  3505.  redo% 
  3506. show_menu(menuhandle%,menux%,menuy%)
  3507. init_drag(wi%,ic%,dragtype%)
  3508. getscreensize(W%,H%)
  3509. !block%=wi%
  3510.  "Wimp_GetWindowState",,block%
  3511. ysize%=block%!16-block%!8
  3512. x%=block%!4-block%!20
  3513. y%=block%!16-block%!24
  3514. block%!4=ic%
  3515.  "Wimp_GetIconState",,block%
  3516. block%!8+=x%:minx%=block%!8
  3517. !block%!12+=y%:miny%=block%!12
  3518. !block%!16+=x%:maxx%=block%!16
  3519. !block%!20+=y%:maxy%=block%!20
  3520.  dragtype%=6 
  3521. 5  block%!24=2*minx%-maxx%:block%!36=2*maxy%-miny%
  3522.  block%!24=0:block%!36=H%
  3523. block%!28=0
  3524. block%!32=W%
  3525. !block%=0
  3526. block%!4=dragtype%
  3527. dragging%=
  3528.  wi% 
  3529.  saveW%,savesubW%:
  3530.  RISCOS3 
  3531. M    
  3532.  wi%=saveW% 
  3533.  sprite$=
  3534. $SaveSprite%,2,8) 
  3535.  sprite$=
  3536. $SubSprite%,2,8)
  3537. 5    
  3538.  "DragASprite_Start",&C5,1,sprite$,block%+8
  3539. #    
  3540.  "Wimp_DragBox",,block%
  3541.  "Wimp_DragBox",,block%
  3542.  wi%=mainW% 
  3543.  ficon%=ic%
  3544. end_drag(start%,end%)
  3545. dragging%=
  3546. datasize%=end%-start%
  3547.  "Wimp_GetPointerInfo",,block%
  3548. wi%=block%!12
  3549. =block%!32=block%!4:block%!28=block%!0:block%!24=block%!16
  3550. #block%!20=block%!12:block%!16=1
  3551. 3block%!12=0:block%!36=datasize%:block%!40=Type%
  3552.  design% 
  3553. adjust_field(dragbutt%)
  3554.  Filename$<>"" 
  3555.  wi%<>mainW% 
  3556. %    $(block%+44)=
  3557. leaf(Filename$)
  3558.     !block%=60
  3559. ;    
  3560.  "Wimp_SendMessage",17,block%,block%!20,block%!24
  3561.     ramptr%=start%
  3562.      
  3563.  "Wimp_CreateMenu",,-1
  3564. encrypt(S$,Z%)
  3565.  I%,R%
  3566. (-12817)
  3567.  I%=1 
  3568.   R%=
  3569. (58)-1
  3570.  R%=58-R%
  3571. S$,I%,1)=
  3572. S$,I%,1))-65+R%) 
  3573.  58+65)
  3574. leaf(s$)
  3575. s2$=""
  3576. s$)<>"." 
  3577.  s$<>""
  3578.   s2$=
  3579. s$)+s2$
  3580.   s$=
  3581. dbasepath$=
  3582.  Message handling ----------------------------------------------------
  3583. not_acknowledged
  3584.  block%!16 
  3585.  DataOpen failed, so run file
  3586.  block%!8=Impref% 
  3587.  Imp_wait%=
  3588.  "Wimp_StartTask",$(block%+44)
  3589.  RAMTransmit failed
  3590.  merging% 
  3591.  moan_err%,
  3592. msg(39)
  3593.  DataLoad failed, so delete scrapfile (if ours)
  3594.  block%!8=myref% 
  3595.  "OS_File",6,block+44
  3596.  moan_err%,
  3597. msg(39)
  3598.  &80142:
  3599.  moan_err%,
  3600. msg(90)
  3601. message
  3602.  task%,ref%,myref%
  3603.  task%=block%!4:ref%=block%!8
  3604.  block%!16 
  3605.  0:quit%=
  3606.  ### DataSave ###
  3607.  task%<>mytask% 
  3608.  present%=7 
  3609.     datasize%=block%!36
  3610.  block%!40 
  3611.        
  3612.  &fff,&ff9,&aff,&dfe:
  3613.       myref%=ref%
  3614. >      block%!0=256:block%!12=ref%:block%!16=2:block%!36=-1
  3615. *      $(block%+44)="<Wimp$Scrap>"+
  3616. /      
  3617.  "Wimp_SendMessage",17,block%,task%
  3618.         
  3619.  ### DataSaveAck ###
  3620. save(
  3621. getstr(block%+44),Type%,Start%,End%)
  3622. 8  myref%=ref%:block%!12=ref%:block%!16=3:!block%=256
  3623.  "Wimp_SendMessage",18,block%,task%
  3624.  "Wimp_CreateMenu",,-1
  3625.  ### DataLoad ###
  3626. ,  myref%=block%!12:f$=
  3627. getstr(block%+44)
  3628. get_it_in(f$)
  3629.  myref%<>0 
  3630.  "OS_CLI","Remove <Wimp$Scrap>"
  3631.  ### DataLoadAck ###
  3632.  block%!12=Impref% 
  3633.  merging% 
  3634. ready_to_merge
  3635.  ### DataOpen - response to file double click ###
  3636.  block%!40 
  3637.  &7f1,&7f3,&7f4,&7f5:
  3638.  present%=7 
  3639. 0      block%!0=20:block%!12=ref%:block%!16=4
  3640. )      
  3641.  "Wimp_SendMessage",17,block%
  3642. (      
  3643. get_it_in(
  3644. getstr(block%+44))
  3645.         
  3646.  &2000:
  3647.  kill% 
  3648.  present%=0 
  3649. *      f$=
  3650. getstr(block%+44)+".Indices"
  3651.        
  3652.  "OS_File",5,f$ 
  3653.       
  3654.  d%=2 
  3655. 2        block%!0=20:block%!12=ref%:block%!16=4
  3656. +        
  3657.  "Wimp_SendMessage",17,block%
  3658.  *        
  3659. get_it_in(
  3660. getstr(block%+44))
  3661.       
  3662. "        
  3663.  savefunc$<>"Save list" 
  3664.  savefunc$<>"Export CSV" 
  3665. ram_transmit
  3666.  &502:
  3667. help_message(block%!32,block%!36)
  3668.  &400C2:
  3669. getscreensize(ScreenWidth%,ScreenHeight%)
  3670.  &400C0:
  3671. message_menu_select
  3672.  &80140:
  3673.  ### PrintFile - ignore ###
  3674. ram_transmit
  3675.  datasize%>block%!24 
  3676.  tosend%=block%!24 
  3677.  tosend%=datasize%
  3678.  "Wimp_TransferBlock",mytask%,ramptr%,block%!4,block%!20,tosend%
  3679. block%!24=tosend%
  3680. datasize%-=tosend%
  3681. ramptr%+=tosend%
  3682. block%!12=block%!8
  3683. block%!16=7
  3684.  "Wimp_SendMessage",18+(datasize%=0),block%,block%!4
  3685. message_menu_select
  3686.  P%,Q%,I%
  3687. keyfunc$="":savefunc$=""
  3688. :5handle%=block%!20:xmin%=block%!24:ymax%=block%!28
  3689.  "Wimp_DecodeMenu",,menuhandle%,block%+32,choices%
  3690.  I%=1 
  3691.   Q%=
  3692. $choices%,".",P%+1)
  3693. ?&  choice$(I%)=
  3694. $choices%,P%,Q%-P%)
  3695.   P%=Q%+1
  3696.  menuhandle% 
  3697.  menu%(0):
  3698.  choice$(1) 
  3699.  "New database":
  3700.     $SaveName%="!DataBase"
  3701. G2    $SaveSprite%="snew_appl;Pptr_hand,12,8;B3"
  3702.     savefunc$=choice$(1)
  3703.  menu%(1):
  3704.  choice$(1) 
  3705. L6    
  3706.  "Information":
  3707. count(key%,RU%):
  3708. update_stats
  3709.  "Print":
  3710.  choice$(2) 
  3711.       
  3712.  "Save options":
  3713. P5      $SaveName%=$database%+".PrintRes.PrintOpts"
  3714. Q4      $SaveSprite%="sfile_7f5;Pptr_hand,12,8;B3"
  3715.       
  3716.  "Save query":
  3717. S1      $SaveName%=$database%+".PrintRes.Query"
  3718. T4      $SaveSprite%="sfile_7f4;Pptr_hand,12,8;B3"
  3719.       
  3720.  "Save selection":
  3721. V5      $SaveName%=$database%+".PrintRes.Selection"
  3722. W4      $SaveSprite%="sfile_7f3;Pptr_hand,12,8;B3"
  3723. X        
  3724.     savefunc$=choice$(2)
  3725.  "Miscellaneous":
  3726.  choice$(2) 
  3727.       
  3728.  "Batch delete":
  3729. ]C      
  3730. select(moveW%,2):
  3731. deselect(moveW%,1):
  3732. deselect(moveW%,0)
  3733. ^+      
  3734.  common% 
  3735. text(moveW%,7)=""
  3736.       
  3737.  "Colours":
  3738.       ncol%()=fcol%()
  3739.       
  3740.  I%=0 
  3741. b.        
  3742. set_icon_cols(colW%,I%,ncol%(I%))
  3743.       
  3744. d8      !block%=colW%:
  3745.  "Wimp_GetWindowState",,block%
  3746. e#      width%=block%!12-block%!4
  3747. f/      block%!4=xmin%:block%!12=xmin%+width%
  3748. g0      block%!8=ymax%-height%:block%!16=ymax%
  3749. h        
  3750.  "Export subset":
  3751. jA    export%=
  3752. :$SubTitle%="Export subset":savefunc$=choice$(1)
  3753. kV    $SubName%=$database%+".PrintJobs.!Subset":
  3754.  common% 
  3755. text(savesubW%,0)=""
  3756. l1    $SubSprite%="snew_appl;Pptr_hand,12,8;B3"
  3757.  "Export CSV":
  3758. n9    $SubTitle%="Export CSV file":savefunc$=choice$(1)
  3759. o:    
  3760.  sep$="," 
  3761.  t$="dfe":f$="CSV" 
  3762.  t$="fff":f$="Sep"
  3763. pY    $SubName%=$database%+".PrintJobs."+f$+"file":
  3764.  common% 
  3765. text(savesubW%,0)=""
  3766. q4    $SubSprite%="sfile_"+t$+";Pptr_hand,12,8;B3"
  3767.  menu%(9):
  3768.  choice$(1) 
  3769.  "Save form file":
  3770. v%    $SaveName%=$database%+".Form"
  3771. w2    $SaveSprite%="sfile_7f2;Pptr_hand,12,8;B3"
  3772.     savefunc$=choice$(1)
  3773.  menu%(17):
  3774.  choice$(1) 
  3775.  "Save":
  3776. }&    T%=
  3777. table_number($menuhandle%)
  3778. ~6    $SaveName%=$database%+".ValTables."+table$(T%)
  3779. 2    $SaveSprite%="sfile_7f1;Pptr_hand,12,8;B3"
  3780.     savefunc$="Save table"
  3781.  menu%(18):
  3782.  choice$(1) 
  3783.  "Save as text":
  3784. /    $SaveName%=$database%+".PrintJobs.List"
  3785. 2    $SaveSprite%="sfile_fff;Pptr_hand,12,8;B3"
  3786.   savefunc$=choice$(1)
  3787.  "Wimp_CreateSubMenu",,handle%,xmin%,ymax%
  3788. help_message(wi%,ic%)
  3789.  wi% 
  3790. send_help(75)
  3791.  infoW%:
  3792. send_help(76)
  3793.  miscW%:
  3794. send_help(77)
  3795.  mainW%:
  3796.  design% 
  3797.  ic%>=0 
  3798.     F%=(ic%+1) 
  3799.  chartype%(F%) 
  3800. A      
  3801.  0,1,2,3,4,5,6,7,8,36,39,41,42,43,44,45:
  3802. send_help(78)
  3803. +      
  3804.  "Interface_SendHelp",,block%
  3805.         
  3806.  pselectW%:
  3807. send_help(79)
  3808.  relateW%:
  3809. send_help(80)
  3810.  listW%:
  3811. send_help(81)
  3812.  datadicW%:
  3813. send_help(82)
  3814.  saveW%:
  3815. send_help(83)
  3816.  savesubW%:
  3817. send_help(84)
  3818.  accessW%:
  3819. send_help(85)
  3820.  mergeW%:
  3821. send_help(86)
  3822.  "Interface_SendHelp",,block%
  3823. send_help(M%)
  3824. !block%=256
  3825. block%!12=ref%
  3826. block%!16=&503
  3827. $(block%+20)=
  3828. msg(M%)
  3829.  "Wimp_SendMessage",17,block%,block%!4
  3830.  File saving --------------------------------------------------------
  3831. save_all_tables
  3832.  "Hourglass_On"
  3833.  T%<=LastTable%
  3834. ,  f$=$database%+".ValTables."+table$(T%)
  3835. E  $TabTitle%=
  3836. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  3837. 7  Start%=!tabanchor%(T%):End%=Start%+160+Rows%*Rec%
  3838. save(f$,&7f1,Start%,End%)
  3839.   T%+=1
  3840.  "Hourglass_Percentage",T%*100 
  3841.  (LastTable%+1)
  3842.  "Hourglass_Off"
  3843. save_options
  3844.  F,I%,ic%
  3845.  I%=1 
  3846. selected(printW%,ic%)
  3847.  I%=1 
  3848. text(printW%,ic%)
  3849.  I%=1 
  3850. selected(printW%,ic%)
  3851.  I%=1 
  3852. selected(labelW%,ic%)
  3853.  I%=1 
  3854. text(labelW%,ic%)
  3855.  I%=1 
  3856. selected(labelW%,ic%)
  3857. close_file(F)
  3858.  "OS_File",18,f$,&7f5
  3859.  1,2,4,6,7,8,23,24,25,26,38,39,41:REM Radio buttons
  3860.  15,16,17,18,30,32,34,43,45:REM Writable fields
  3861.  10,11,12,19,29,40,42:REM Option switches
  3862.  In Label Definition window
  3863.  0,1,2:REM Radio buttons
  3864.  4,6,10,12:REM Writeable fields
  3865.  11,13,16:REM Option switches
  3866. save(f$,ft%,start%,end%)
  3867.  ft% 
  3868.   leaf$=
  3869. leaf(f$)
  3870. leaf$,1)<>"!" 
  3871.  leaf$="!"+
  3872. leaf$,9):f$=dbasepath$+"."+leaf$
  3873.  "OS_File",8,f$
  3874.  "OS_File",8,f$+".Indices"
  3875.  "OS_File",8,f$+".ValTables"
  3876.  "OS_File",8,f$+".PrintRes"
  3877.  "OS_File",8,f$+".PrintJobs"
  3878.  "OS_CLI","Copy <PBase$Dir>.Resources.Temp.!Run "+f$+".!Run ~C~V"
  3879.  "OS_CLI","Copy <PBase$Dir>.Resources.Temp.!Boot "+f$+".!Boot ~C~V"
  3880.  "OS_CLI","Copy <PBase$Dir>.Resources.chkspr "+f$+".chkspr ~C~V"
  3881.  "OS_CLI","Copy <PBase$Dir>.Resources.Colours "+f$+".Colours ~C~V"
  3882. copy_database_spritefile(f$,
  3883. leaf(f$))
  3884. $    
  3885.  export%:
  3886. export_subset(f$)
  3887.  csvconv%:
  3888.  !formanchor%=0 
  3889. 4      
  3890. extend_named_sliding_block(formanchor%,0)
  3891.       Fptr%=!formanchor%
  3892. "      fields%=0:Fieldnumber%=0
  3893. "      fields%=
  3894. get_form(Fptr%)
  3895.         
  3896. lit(menu%(0),1,
  3897. get_it_in(f$)
  3898. open_window(mainW%)
  3899.  !formanchor%=0 
  3900. 4      
  3901. extend_named_sliding_block(formanchor%,0)
  3902.       Fptr%=!formanchor%
  3903. "      fields%=0:Fieldnumber%=0
  3904.         
  3905.  "OS_CLI","CDir "+f$:
  3906.   logpath$=f$
  3907. close_window(saveW%)
  3908.  &7f2:
  3909. save_form(f$):
  3910. get_it_in($database%)
  3911.  &7f5:
  3912. save_options
  3913.  &dfe:
  3914. write_csv(f$)
  3915.  startlog%:
  3916. close_log
  3917.     logpath$=f$
  3918.     loghandle%=
  3919. (logpath$)
  3920. #loghandle%,$database%
  3921. 3    
  3922. #loghandle%,"Password level used: "+
  3923. (pw%)
  3924. &    
  3925. #loghandle%,"Log started "+
  3926. #loghandle%,
  3927. 36,"=")
  3928.     startlog%=
  3929.  savetofile%:
  3930.     texthandle%=
  3931. "    
  3932. do_it(Search$,displayed%)
  3933.  +    
  3934.  "OS_File",10,f$,ft%,,start%,end%
  3935. !)    
  3936. scrap_sliding_block(saveanchor%)
  3937. warn%=
  3938. getstr(p%)
  3939.  ?p%>31
  3940.   p$+=
  3941. (?p%)
  3942.   p%+=1
  3943.  Validation tables ----------------------------------------------------
  3944. create_table
  3945.  I%,title$,Rec%
  3946.  %111 
  3947.  ic% 
  3948.  LastTable%=MaxTabs% 
  3949. 8&      
  3950. softerror(
  3951. (MaxTabs%+1),32)
  3952.       
  3953.       LastTable%+=1
  3954. ;!      Tablenumber%=LastTable%
  3955. <!      name$=$
  3956. text(tableW%,0)
  3957. ="      table$(LastTable%)=name$
  3958. >$      Rows%=
  3959. text(tableW%,1))
  3960. ?)      TabFields%=
  3961. text(tableW%,2))
  3962.       
  3963.  I%=0 
  3964.  TabFields%
  3965. A6        tabfieldlen%(I%)=
  3966. text(tableW%,I%*2+4))
  3967. B$        Rec%+=tabfieldlen%(I%)+1
  3968.       
  3969. D       tablen%=160+Rows%*Rec%
  3970. EO      
  3971. create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3) 
  3972. F)      tabptr%=!tabanchor%(LastTable%)
  3973. G2      $tabptr%=
  3974. (Rows%):tabptr%+=
  3975. ($tabptr%)+1
  3976. H7      $tabptr%=
  3977. (TabFields%):tabptr%+=
  3978. ($tabptr%)+1
  3979.       
  3980.  I%=0 
  3981.  TabFields%
  3982. J?        $tabptr%=
  3983. (tabfieldlen%(I%)):tabptr%+=
  3984. ($tabptr%)+1
  3985. K(        head$=$
  3986. text(tableW%,I%*2+3)
  3987. L;        title$+=head$+
  3988. tabfieldlen%(I%)-
  3989. (head$)+2," ")
  3990.       
  3991. N=      $tabptr%=title$:tabptr%=!tabanchor%(LastTable%)+160
  3992.       
  3993.  row%=1 
  3994.  Rows%
  3995.         
  3996.  I%=0 
  3997.  TabFields%
  3998. Q5          $tabptr%="":tabptr%+=tabfieldlen%(I%)+1
  3999.         
  4000.       
  4001.  row%
  4002. T!      
  4003. show_table(LastTable%)
  4004. U!      Tablenumber%=LastTable%
  4005. V       TabsLoaded$+=","+name$
  4006. W+      
  4007.  menu%(5)>0 
  4008.  menu_ptr%=menu%(5)
  4009. X:      menu%(5)=
  4010. create_menu(menu_ptr%,140,TabsLoaded$)
  4011. Y=      ptr%=menu%(2)+52:ptr%!4=menu%(5):
  4012. lit(menu%(2),1,
  4013. Z        
  4014. close_window(tableW%)
  4015. clear_table(T%)
  4016. confirm(
  4017. msg(47))=
  4018.  R%,F%,ind%,Rows%,TabFields%,start%,Rec%
  4019. c;T$=
  4020. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4021. d#start%=!tabanchor%(T%)+160-Rec%
  4022.  R%=1 
  4023.  Rows%
  4024.   ind%=start%+R%*Rec%
  4025.  F%=0 
  4026.  TabFields%
  4027. h)    $ind%="":ind%+=tabfieldlen%(F%)+1
  4028. show_table(T%)
  4029. show_table(T%)
  4030.  ind%,start%,iflags%,I%,pos%,p$
  4031.  T%<0 
  4032. delete_icons(datadicW%,0)
  4033. name$=table$(T%)
  4034. $Tablename%=name$
  4035. $menu%(17)=name$
  4036.  "OS_File",5,$database%+".ValTables."+name$ 
  4037.  d%,,,,tablen%
  4038. extend_named_sliding_block(undoanchor%,tablen%+1)
  4039.  "Wimp_TransferBlock",mytask%,!tabanchor%(T%),mytask%,!undoanchor%,tablen%+1
  4040. xC$TabTitle%=
  4041. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4042. ind%=!tabanchor%(T%)+160
  4043. iflags%=&07003531
  4044.  "Hourglass_On"
  4045.  row%=1 
  4046.  Rows%
  4047.   pos%=80
  4048.  I%=0 
  4049.  TabFields%
  4050. v    R%=
  4051. create_icon(datadicW%,pos%,-row%*36,(tabfieldlen%(I%)+1)*16,32,iflags%,"",ind%,writep%,tabfieldlen%(I%)+1)
  4052. %    pos%+=(tabfieldlen%(I%)+2)*16
  4053.      ind%+=tabfieldlen%(I%)+1
  4054.  "Hourglass_Percentage",row%*100 
  4055.  Rows%
  4056.  row%
  4057.  "Hourglass_Off"
  4058. p$=printrel$(T%)
  4059.  p$<>"" 
  4060.  I%=1 
  4061. '    
  4062. select(datadicW%,
  4063. p$,I%,1)))
  4064. "!block%=0:block%!4=-Rows%*36-4
  4065. %block%!8=(Rec%+10)*16:block%!12=0
  4066.  "Wimp_SetExtent",datadicW%,block%
  4067. !block%=datadicW%
  4068.  "Wimp_GetWindowState",,block%
  4069. #block%!12=block%!4+(Rec%+10)*16
  4070.  Rows%<20 
  4071. #  block%!16=block%!8+Rows%*36+4
  4072.    block%!16=block%!8+36*20+4
  4073.  "Wimp_OpenWindow",,block%
  4074. redraw(datadicW%)
  4075.  Access% 
  4076. set_caret(datadicW%,0)
  4077. restore_table(T%,L%)
  4078.  "Wimp_TransferBlock",mytask%,!undoanchor%,mytask%,!tabanchor%(T%),L%+1
  4079. redraw(datadicW%)
  4080. restore_tabfield
  4081.  source%,dest%
  4082.  "Wimp_GetCaretPosition",,block%:wi%=!block%:ic%=block%!4
  4083.  wi%=datadicW% 
  4084.    dest%=
  4085. text(datadicW%,ic%)
  4086. :  source%=!undoanchor%+dest%-!tabanchor%(Tablenumber%)
  4087.   $dest%=$source%
  4088. redraw_icon(datadicW%,ic%)
  4089. sort_table(T%)
  4090. ?title$=
  4091. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4092. !ind%=!tabanchor%(T%)+160-Rec%
  4093.  row%=0 
  4094.  Rows%-1
  4095.   ind%+=Rec%
  4096.   block%!(row%*4)=ind%
  4097.  $ind%="" 
  4098.  $ind%="~"
  4099.  row%
  4100.  "OS_HeapSort",Rows%,(block% 
  4101.  (1<<30) 
  4102.  (1<<31)),4,,!tabanchor%(T%)+160,Rec%
  4103. !ind%=!tabanchor%(T%)+160-Rec%
  4104.  row%=0 
  4105.  Rows%-1
  4106.   ind%+=Rec%
  4107.  $ind%="~" 
  4108.  $ind%=""
  4109.  row%
  4110. redraw(datadicW%)
  4111. print_table(T%)
  4112.  printing% 
  4113.  indexing% 
  4114.  start%,ptr%,Line$,title$,rowsused%
  4115. read_print_options
  4116. format$="horiz"
  4117. ?title$=
  4118. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4119. !LenLine%=Lmargin%+
  4120. (title$)+2
  4121. 0Heading$=margin$+title$+
  4122. Rec%-
  4123. (title$)," ")
  4124. extend_named_sliding_block(lineanchor%,LenLine%+4)
  4125. extend_named_sliding_block(headanchor%,LenLine%+4):pos%=!headanchor%
  4126. heap_store(headanchor%,LenLine%,0,pos%,0,Heading$)
  4127. Title$="Validation table"
  4128. Title1$=table$(T%)
  4129. Title2$=""
  4130. reportdest$="Window"
  4131. close_window(datadicW%)
  4132. Count%=0
  4133. list_head(0)
  4134.  "Hourglass_On"
  4135.  I%=1 
  4136.  Rows%
  4137. %  start%=!tabanchor%(T%)+160-Rec%
  4138.   Line$=margin$
  4139.   ptr%=start%+I%*Rec%
  4140.  J%=0 
  4141.  TabFields%
  4142. D    
  4143.  $ptr%<>"" 
  4144.  Line$+=$ptr%+
  4145. tabfieldlen%(J%)-
  4146. ($ptr%)+2," ")
  4147.      ptr%+=tabfieldlen%(J%)+1
  4148.  Line$<>margin$ 
  4149.     rowsused%+=1
  4150. D    $(!lineanchor%)=Line$:
  4151. list_line(-1,lineanchor%,
  4152. (Line$),32)
  4153.  "Hourglass_Percentage",I%*100 
  4154.  Rows%
  4155.  "Hourglass_Off"
  4156. rule_off(45)
  4157. S$=margin$+
  4158. (Rows%)+" rows"
  4159. :$(!lineanchor%)=S$:
  4160. list_line(-1,lineanchor%,
  4161. (S$),32)
  4162. #S$=margin$+
  4163. (rowsused%)+" used"
  4164. :$(!lineanchor%)=S$:
  4165. list_line(-1,lineanchor%,
  4166. (S$),32)
  4167. rule_off(45)
  4168. screen_list
  4169. pitch$=
  4170. pitch("0")
  4171. lit(menu%(18),1,
  4172. table_number(N$)
  4173.  T%,P%
  4174.  N$="" 
  4175.     T%=-1
  4176.   T%+=1
  4177.  table$(T%)=N$ 
  4178.  T%>LastTable%
  4179.  T%>LastTable% 
  4180. table_info(T%,
  4181.  RL%,L%())
  4182.  P%,I%
  4183. P%=!tabanchor%(T%)
  4184. ($P%):P%+=
  4185. ($P%)+1
  4186. ($P%):P%+=
  4187. ($P%)+1
  4188.     RL%=0
  4189.  I%=0 
  4190.    L%(I%)=
  4191. ($P%):P%+=
  4192. ($P%)+1
  4193.   RL%+=L%(I%)+1
  4194. table_field(F%,L%())
  4195.  I%,P%
  4196.  I%<F%
  4197.   P%+=L%(I%)+1
  4198.   I%+=1
  4199. drag_table(f$)
  4200.  pos%,name$,d%
  4201. Tablenumber%=-1
  4202. name$=
  4203. leaf(f$)
  4204. TabsLoaded$,name$)>0 
  4205.  "OS_File",5,f$ 
  4206.  d%,,,,tablen%
  4207.  LastTable%=MaxTabs% 
  4208. extratabs$,name$)=0 
  4209.  extratabs$+=name$+","
  4210.   LastTable%+=1
  4211. create_named_sliding_block(tabanchor%(LastTable%),(tablen%+3) 
  4212.  "OS_File",255,f$,!tabanchor%(LastTable%)
  4213.   table$(LastTable%)=name$
  4214.   Tablenumber%=LastTable%
  4215.   TabsLoaded$+=","+name$
  4216.  menu%(5)>0 
  4217.  menu_ptr%=menu%(5)
  4218. 6  menu%(5)=
  4219. create_menu(menu_ptr%,140,TabsLoaded$)
  4220. 9  ptr%=menu%(2)+52:ptr%!4=menu%(5):
  4221. lit(menu%(2),1,
  4222. link_to_table
  4223.  icon%
  4224.  %111 
  4225.  2,4:
  4226.  ic%=13 
  4227. "5    
  4228. tick_one(menu%(5),0,LastTable%,Tablenumber%)
  4229. #+    
  4230. show_menu(menu%(5),oldx%+32,oldy%)
  4231.  %111 
  4232.  1,4:
  4233.  (b% 
  4234.  %111)=4 
  4235.  z%=1 
  4236.  z%=-1
  4237.  ic% 
  4238. tcycle(z%)
  4239. tcycle(-z%)
  4240. ,!    
  4241. fcycle(z%,fieldnum%)
  4242. -"    
  4243. fcycle(-z%,fieldnum%)
  4244. .     
  4245. fcycle(z%,expand%)
  4246. /!    
  4247. fcycle(-z%,expand%)
  4248.  icon%=10 
  4249. 28      
  4250. icon_bit(22,linkW%,icon%,
  4251. selected(linkW%,9))
  4252.  icon%
  4253. 5"    icon%=field%(Fieldnumber%)
  4254. 61    
  4255. selected(linkW%,4) 
  4256.  $Tablename%<>"" 
  4257. 74      link$(Fieldnumber%)=$Tablename%+$fieldnum%
  4258. 8/      
  4259. set_icon_cols(mainW%,icon%,fcol%(6))
  4260. 9R      
  4261. selected(linkW%,9) 
  4262.  link$(Fieldnumber%)=$expand%+link$(Fieldnumber%)
  4263.       
  4264. ;       link$(Fieldnumber%)=""
  4265. <(      
  4266. set_icon_cols(mainW%,icon%,7)
  4267. =        
  4268.     link$(0)="LOADED"
  4269. ?/    
  4270.  (b% 
  4271.  %111)=4 
  4272. close_window(linkW%)
  4273. tcycle(z%)
  4274.  LastTable%=-1 
  4275. Tablenumber%+=z%
  4276.  Tablenumber%>LastTable% 
  4277.  Tablenumber%=0
  4278.  Tablenumber%<0 
  4279.  Tablenumber%=LastTable%
  4280. I$$Tablename%=table$(Tablenumber%)
  4281. redraw_icon(linkW%,0)
  4282. fcycle(z%,column%)
  4283. NET$=
  4284. table_info(Tablenumber%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4285. field%=
  4286. ($column%)
  4287. field%+=z%
  4288.  field%>TabFields% 
  4289.  field%=0
  4290.  field%<0 
  4291.  field%=TabFields%
  4292. $column%=
  4293. (field%)
  4294. redraw_icon(linkW%,2)
  4295. redraw_icon(linkW%,10)
  4296. link_status
  4297.  name$,name1$,field$,expand$,ic%
  4298. name$=link$(Fieldnumber%)
  4299. (name$)<58 
  4300. (name$)<>-1 
  4301.  expand$=
  4302. name$,1):name$=
  4303. name$,2)
  4304. \!field$=
  4305. name$):name1$=
  4306. name$)
  4307.  (name1$<>"" 
  4308. TabsLoaded$,name1$)>0) 
  4309. ^;  $Tablename%=name1$:$fieldnum%=field$:$expand%=expand$
  4310. _(  Tablenumber%=
  4311. table_number(name1$)
  4312. select(linkW%,4)
  4313.   Tablenumber%=0
  4314. c&  $Tablename%=table$(Tablenumber%)
  4315. deselect(linkW%,4):$fieldnum%="0"
  4316.  expand$<>"" 
  4317. select(linkW%,9):$expand%=expand$
  4318. deselect(linkW%,9):$expand%="0"
  4319.  ic%=10 
  4320. icon_bit(22,linkW%,ic%,
  4321. selected(linkW%,9))
  4322. redraw_icon(linkW%,0):
  4323. redraw_icon(linkW%,2):
  4324. redraw_icon(linkW%,10)
  4325.  End of Validation table routines ------------------------------------
  4326. changes(key%)
  4327.  M$,K%,index%
  4328. t<Search$=
  4329. parse($
  4330. text(changeW%,3),
  4331. selected(changeW%,5))
  4332. New$=$
  4333. text(changeW%,1)
  4334.  New$="" 
  4335.  n$="<null>" 
  4336.  n$=New$
  4337.  New$<>"" 
  4338. "+-*/",
  4339. New$,1))>0 
  4340.   numeric%=
  4341.  numeric%=
  4342. is_a_key(Fieldnumber%)
  4343.  K%=key% 
  4344. softerror("",12):
  4345.  "Wimp_CreateMenu",,-1:
  4346.  K%>=0 
  4347.  M$=" NOTE! Index on this field will NO LONGER BE VALID and will be deleted." 
  4348.  M$=""
  4349. ~)P%=
  4350. Title$,". "):Title$=
  4351. Title$,P%+2)
  4352.  Title$<>"All records" 
  4353.  Title$=" when "+Title$ 
  4354.  Title$=" for "+Title$
  4355. 8Title$="Change "+Fieldname$+" to "+n$+Title$+". "+M$
  4356. confirm(Title$)=
  4357. '  subtotal%=
  4358. count_recs(key%,zero%)
  4359.  "Hourglass_On"
  4360. ,  dbasehandle%=
  4361. ($database%+".Database")
  4362.   P%=
  4363. neighbour(key%,top,1)
  4364. scan_file("P%<>top",key%,5)
  4365. close_file(dbasehandle%)
  4366.   $Date%(file%)=
  4367.   date%?file%=1
  4368. display(key%,addr)
  4369.  "Hourglass_Off"
  4370.  K%>=0 
  4371.  index%=K% 
  4372.  Keys%
  4373. !      Index$(K%)=Index$(K%+1)
  4374.  index%
  4375. ,    
  4376. scrap_sliding_block(keyanchor%(K%))
  4377.     Keys%-=1
  4378. selected(passW%,16) 
  4379. #loghandle%,Title$
  4380.  "Wimp_CreateMenu",,-1
  4381. is_a_key(F%)
  4382.  key%,flag%
  4383. flag%=-1
  4384.  key%=0 
  4385.  Keys%
  4386.  KF%(key%,0)=F% 
  4387.  KF%(key%,1)=F% 
  4388.  flag%=key%
  4389.  key%
  4390. =flag%
  4391. read(N%,K%,R%,f$)
  4392.  I%,key%,dbasehandle%
  4393. "dbasehandle%=
  4394. (f$+".Database")
  4395. %$Rf%(0)="":field$(0)="":key$()=""
  4396. #dbasehandle%=
  4397. (R%)*Length%
  4398.  I%=1 
  4399.   field$(I%)=
  4400. #dbasehandle%
  4401.  chartype%(I%)<>40 
  4402.  chartype%(I%)<>59 
  4403.  $Rf%(I%)=field$(I%)
  4404.  chartype%(I%) 
  4405. 8    
  4406.  36,37,38:
  4407. set_blob_sprite(R%,I%,chartype%(I%))
  4408. !    
  4409. show_text_block(I%)
  4410. show_picture(I%)
  4411.  41,42,43,44,45:
  4412. T    
  4413.  field$(I%)=" " 
  4414. select(mainW%,field%(I%)) 
  4415. deselect(mainW%,field%(I%))
  4416. ,    
  4417.  R%=RA% 
  4418.  $Rf%(I%)=
  4419. (nextrec%)
  4420. 9    
  4421.  R%=RA% 
  4422. split_link(I%,R$,V$):$Rf%(I%)=R$
  4423. '    
  4424.  R%=RA% 
  4425.  $Rf%(I%)=
  4426. (    
  4427.  R%=RA% 
  4428.  $Rf%(I%)=
  4429. $,15)
  4430. 1    
  4431.  R%=RA% 
  4432.  $Rf%(I%)=
  4433. convert_date(2)
  4434. 1    
  4435.  R%=RA% 
  4436.  $Rf%(I%)=
  4437. convert_date(4)
  4438. #    
  4439.  R%=RA% 
  4440.  $Rf%(I%)=
  4441. '    
  4442.  R%=RA% 
  4443.  $Rf%(I%)=
  4444. )    
  4445.  R%=RA% 
  4446.  $Rf%(I%)=
  4447. $,5,2)
  4448. )    
  4449.  R%=RA% 
  4450.  $Rf%(I%)=
  4451. $,8,3)
  4452. J    
  4453.  R%=RA% 
  4454. $,8,3):P%=
  4455. months$,M$):$Rf%(I%)=
  4456. ((P%+2) 
  4457. *    
  4458.  R%=RA% 
  4459.  $Rf%(I%)=
  4460. $,12,4)
  4461.  key%=0 
  4462.  Keys%
  4463.     key$(key%)=
  4464. key(key%)
  4465.  key%
  4466. close_file(dbasehandle%)
  4467. update_calcs(N%)
  4468.  design% 
  4469.  I%,C%,L%,F,F$,Form$,S$,SF$
  4470. Form$=update$(N%)
  4471.  Form$=0 
  4472.  I%=1 
  4473. (Form$)-1 
  4474.   F%=
  4475. fnum(
  4476. Form$,I%,2))
  4477. split_link(F%,real$,visible$)
  4478. calc_error:
  4479.  chartype%(F%) 
  4480. >    F=
  4481. (real$):F$=
  4482.  fix%(F%)>0 
  4483. fix_point(F$,F%)
  4484.     F$=
  4485. (real$)
  4486. 7    
  4487.  N%=0 
  4488. expand(F$,link$(F%),L%,SF$):F$=SF$
  4489. (F$)<=len%(F%) 
  4490.  $Rf%(F%)=F$:
  4491. redraw_icon(mainW%,field%(F%))
  4492. update_calcs(F%)
  4493. calc_error
  4494.  calcerror%=
  4495. wimp_error(
  4496.  PROCsofterror(calc$(I%),73)
  4497.   calcerror%=
  4498.  calcerror=
  4499. check_change
  4500.  F%,flag%
  4501.  F%<fields% 
  4502.  flag%=
  4503.   F%+=1
  4504.  chartype%(F%) 
  4505. +    
  4506.  0,1,2,3,4,5,6,7,8,41,42,43,44,45:
  4507. (    
  4508.  $Rf%(F%)<>field$(F%) 
  4509.  flag%=
  4510.  flag% 
  4511. write(fields%,key%):warn%=
  4512. write(N%,k%)
  4513.  key%,newrec%,alter%
  4514.  Access% 
  4515. softerror("",14):
  4516. close_file(dbasehandle%)
  4517.  template%=2 
  4518. write_dbase(RA%,N%):template%=0:
  4519. PRI$=
  4520. key(0)
  4521.  PRI$<>"" 
  4522.   kl%=KL%(0):val$=
  4523. type(0)
  4524.  key$(0)="" 
  4525. insert(
  4526. ,PRI$,0)
  4527.  PRI$<>"*Failed*" 
  4528.       newrec%=
  4529.       
  4530.  k%=0 
  4531.  addr=F%
  4532.         
  4533.         
  4534.  PRI$=key$(0) 
  4535.       alter%=
  4536.       
  4537. "      
  4538. confirm(
  4539. msg(48))=
  4540.         alter%=
  4541.         
  4542. delete(key$(0),0)
  4543.         
  4544. insert(
  4545. ,PRI$,0)
  4546.         
  4547.  k%=0 
  4548.  addr=F%
  4549.       
  4550.         
  4551.  newrec% 
  4552.  alter% 
  4553.  key%<Keys%
  4554.   key%+=1
  4555.   KEY$=
  4556. key(key%)
  4557.  KEY$<>key$(key%) 
  4558.  key$(key%)="" 
  4559. &    kl%=KL%(key%):val$=
  4560. type(key%)
  4561. .    
  4562.  newrec% 
  4563. delete(key$(key%),key%)
  4564. insert(
  4565. ,KEY$,key%)
  4566.  key%=k% 
  4567.  addr=F%
  4568. $Date%(file%)=
  4569. date%?file%=1
  4570.  newtree% 
  4571. write_dbase(REC%,N%)
  4572.  newrec% 
  4573.  autobalance% 
  4574.   added%+=1
  4575.  added%=balint% 
  4576.  key%=0 
  4577.  Keys%
  4578.       
  4579. balance(key%)
  4580.  key%
  4581.     added%=0
  4582. write_dbase(R%,N%)
  4583.  I%,F$,dbasehandle%,flag%
  4584. &*dbasehandle%=
  4585. ($database%+".Database")
  4586. #dbasehandle%=R%*Length%
  4587. selected(passW%,16) 
  4588.  newrec% 
  4589. *[    
  4590. #loghandle%,"New record: Subfile "+
  4591. (file%)+"  "+$Rf%(KF%(0,0))+" "+$Rf%(KF%(0,1))
  4592. +(    
  4593. #loghandle%,logentry$:flag%=
  4594.  I%=1 
  4595.  chartype%(I%) 
  4596.  39,40:F$=""
  4597. 1T    
  4598.  47:F$=$Rf%(I%):
  4599. split_link(I%,R$,V$):S%=
  4600. (R$):S%+=1:calc$(I%)=V$+"|"+
  4601.  58:F$=
  4602. :F$=$Rf%(I%)
  4603. #dbasehandle%,F$
  4604.  flag% 
  4605.  F$<> field$(I%) 
  4606. 7%    
  4607.  F$="" 
  4608.  D$="<null>" 
  4609.  D$=F$
  4610. 85    
  4611.  field$(I%)="" 
  4612.  S$="<null>" 
  4613.  S$=field$(I%)
  4614. 91    
  4615. #loghandle%,Tag$(I%)+": "+S$+" ---> "+D$
  4616.   field$(I%)=F$
  4617. close_file(dbasehandle%)
  4618. split_link(F%,
  4619.  L$,P%,F
  4620. L$=calc$(F%)
  4621. L$,1)="#":
  4622. E/  P%=
  4623. L$,"#",2):V$=
  4624. L$,P%+1):R$=
  4625. L$,2,P%-2)
  4626. L$,"|")>0:
  4627. G+  P%=
  4628. L$,"|"):V$=
  4629. L$,P%-1):R$=
  4630. L$,P%+1)
  4631. :R$="":V$=""
  4632. key(key%)
  4633. key2(key%,0)
  4634. key2(key%,loc%)
  4635.  I%,N%,P%,S%,S$,T$,f0%,f1%
  4636. Q(P%=1:f0%=KF%(key%,0):f1%=KF%(key%,1)
  4637.  loc% 
  4638. T   S$=$Rf%(f0%)+" "+$Rf%(f1%)
  4639.   S$=F$(f0%)+" "+F$(f1%)
  4640.  S$=" " 
  4641. S$)<>" " 
  4642.  S$+=" "
  4643.  I%=0 
  4644.   N%=KW%(key%,I%)
  4645.  N%<>0 
  4646.  P%<>
  4647. (S$) 
  4648.     S%=
  4649. S$," ",P%+1)
  4650.  S%-P%<N% 
  4651.  N%=S%-P%
  4652.     T$+=
  4653. S$,P%,N%)
  4654.     P%=S%+1
  4655. KL%(key%)-
  4656. (T$),"#")
  4657.  chartype%(f0%) 
  4658.  5,51,52:T$=
  4659. reverse_date(T$)
  4660.  case%(key%) 
  4661. u(T$)
  4662. u(N$)
  4663.  I%,B%
  4664. $key=N$
  4665.  I%=0 
  4666. (N$)-1
  4667.   B%=key?I%
  4668.  B%>96 
  4669.  B%<123 
  4670.  key?I%=B% 
  4671. p    =$key
  4672.  Y$,M$,D$,M%,date$
  4673. $,14,2)
  4674. $,5,2)
  4675. $,8,3)
  4676. w:M%=(
  4677. "JanFebMarAprMayJunJulAugSepOctNovDec",M$)+2) 
  4678.  M%<10 
  4679.  M$="0"+
  4680. (M%) 
  4681. date$=D$+"-"+M$+"-"+Y$
  4682. =date$
  4683. date(key%)
  4684.  !keyanchor%(key%)=0 
  4685.  I%=0 
  4686.  date%?I%=1 
  4687. )    $(!keyanchor%(key%)+8+9*I%)=
  4688.     $Date%(I%)=
  4689. check_date(D$,place%,
  4690.  date$)
  4691.  I%,D%,M%,Y%,L%,P%,Q%,U$,d$,m$,y$
  4692.  L%=0 
  4693.  I%=1 
  4694.   C$=
  4695. D$,I%,1)
  4696.  C$<"0" 
  4697.  C$>"9" 
  4698.  P%=0 
  4699.  P%=I% 
  4700.  Q%=I%
  4701.  P%=0 
  4702.  Q%=0 
  4703. restore(Fieldnumber%," (day, month & year must be separated by non-numeral)",4):=
  4704. D$,P%-1))
  4705. D$,P%+1,Q%-P%-1))
  4706. D$,Q%+1))
  4707.  Y%<0 
  4708.  D%<1 
  4709. restore(Fieldnumber%,"",4):=
  4710.  M%<1 
  4711.  M%>12 
  4712. restore(Fieldnumber%," (month out of range)",4):=
  4713.  400=0:U$="312931303130313130313031"
  4714.  100<>0 
  4715.  4=0:U$="312931303130313130313031"
  4716. :U$="312831303130313130313031"
  4717. U$,2*M%-1,2)
  4718. (DM$) 
  4719. restore(Fieldnumber%," (day out of range - max="+DM$+")",4):=
  4720. (D%):
  4721. (d$)=1 
  4722.  d$="0"+d$
  4723. (M%):
  4724. (m$)=1 
  4725.  m$="0"+m$
  4726. (Y%):
  4727. (y$)=1 
  4728.  y$="0"+y$
  4729. (y$)<>2 
  4730. (y$)<>4 
  4731. restore(Fieldnumber%," (year not 2 or 4 digits)",4):=
  4732. (y$)=4 
  4733.  len%(Fieldnumber%)<10 
  4734. y$,2)
  4735. $date$=d$+datesep$+m$+datesep$+y$
  4736.  place%=0 
  4737. (date$)>len%(Fieldnumber%) 
  4738. restore(Fieldnumber%," (too long for field)",4):=
  4739.  place% 
  4740. H  $Rf%(Fieldnumber%)=date$:
  4741. redraw_icon(mainW%,field%(Fieldnumber%))
  4742. text(keypadW%,27)=date$:
  4743. redraw_icon(keypadW%,27)
  4744. convert_date(L%)
  4745.  d$,m$,y$,M$,M%
  4746. $,5,2)
  4747. $,8,3)
  4748. months$,M$)
  4749. M%=(P%+2) 
  4750. (M%):
  4751.  M%<10 
  4752.  m$="0"+m$
  4753. $,16-L%,L%)
  4754. =d$+datesep$+m$+datesep$+y$
  4755. reverse_date(K$)
  4756.  sep$
  4757. (K$) 
  4758.   sep$=
  4759. K$,3,1)
  4760. .  K$=
  4761. K$,2)+sep$+
  4762. K$,4,2)+sep$+
  4763. K$,2) 
  4764. (K$)<100 
  4765.     sep$=
  4766. K$,3,1)
  4767. +    K$=
  4768. K$,4)+sep$+
  4769. K$,4,2)+sep$+
  4770. K$,2)
  4771.         
  4772.     sep$=
  4773. K$,5,1)
  4774. +    K$=
  4775. K$,2)+sep$+
  4776. K$,6,2)+sep$+
  4777. K$,4)
  4778. seconds(time$,place%)
  4779.  I%,L%,P%,Q%,H%,M%,S%,secs%,h$,m$,s$,C$
  4780. (time$)
  4781.  L%=0 
  4782.  I%=1 
  4783.   C$=
  4784. time$,I%,1)
  4785.  C$<"0" 
  4786.  C$>"9" 
  4787.  P%=0 
  4788.  P%=I% 
  4789.  Q%=I%
  4790.  P%=0 
  4791.  Q%=0 
  4792. restore(Fieldnumber%," (hours, minutes and seconds must be separated by a non-numeral).",94):=-1
  4793. time$,P%-1)):
  4794.  H%<0 
  4795.  H%>23 
  4796. restore(Fieldnumber%," (hours out of range).",94):=-1
  4797. time$,P%+1,Q%-P%-1)):
  4798.  M%<0 
  4799.  M%>59 
  4800. restore(Fieldnumber%," (minutes out of range).",94):=-1
  4801. time$,Q%+1)):
  4802.  S%<0 
  4803.  S%>59 
  4804. restore(Fieldnumber%," (seconds out of range).",94):=-1
  4805. (H%):
  4806. (h$)=1 
  4807.  h$="0"+h$
  4808. (M%):
  4809. (m$)=1 
  4810.  m$="0"+m$
  4811. (S%):
  4812. (s$)=1 
  4813.  s$="0"+s$
  4814. $time$=h$+timesep$+m$+timesep$+s$
  4815. secs%=H%*3600+M%*60+S%
  4816.  place%=0 
  4817.  $Rf%(Fieldnumber%)=time$:
  4818. redraw_icon(mainW%,field%(Fieldnumber%))
  4819. =secs%
  4820. time(secs%)
  4821.  H%,M%,S%,h$,m$,s$
  4822. &H%=secs% 
  4823.  3600:secs%=secs% 
  4824.  3600
  4825. M%=secs% 
  4826. S%=secs% 
  4827. (H%):
  4828. (h$)=1 
  4829.  h$="0"+h$
  4830. (M%):
  4831. (m$)=1 
  4832.  m$="0"+m$
  4833. (S%):
  4834. (s$)=1 
  4835.  s$="0"+s$
  4836. =h$+timesep$+m$+timesep$+s$
  4837. validate(F%,
  4838.  TabFields%,
  4839.  name$)
  4840.  validate% 
  4841.  row%,field%,Rows%,Rec%,ind%,eind%,pos%,start%,rel%,exp%,epos%,date$
  4842.  fix%(F%)>0 
  4843.  $Rf%(F%)=
  4844. fix_point($Rf%(F%),F%):
  4845. redraw_icon(mainW%,field%(F%))
  4846.  chartype%(F%)=3 
  4847. check_val(calc$(F%),$Rf%(F%))
  4848.  chartype%(F%)=5 
  4849. check_date($Rf%(F%),0,date$)
  4850.  chartype%(F%)=8 
  4851. seconds($Rf%(F%),0)>=0)
  4852.  $Rf%(F%)=field$(F%) 
  4853.  TabFields%=0 
  4854. 3name$=link$(F%):Tablenumber%=-1:rel%=TabFields%
  4855.  name$="" 
  4856. name$,1)="#" 
  4857. #field%=
  4858. name$)):name$=
  4859. name$)
  4860. Hexp%=-1:
  4861. (name$)<58 
  4862. (name$)<>-1 
  4863.  exp%=
  4864. (name$):name$=
  4865. name$,2)
  4866. table_number(name$):
  4867.  T%<0 
  4868. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  4869. ,pos%=
  4870. table_field(field%,tabfieldlen%())
  4871.  exp%<0 
  4872.  epos%=pos% 
  4873.  epos%=
  4874. table_field(exp%,tabfieldlen%())
  4875. #start%=!tabanchor%(T%)+160-Rec%
  4876. 'ind%=start%+pos%:eind%=start%+epos%
  4877.  row%+=1
  4878.   ind%+=Rec%:eind%+=Rec%
  4879.  row%>Rows% 
  4880.  $ind%=$Rf%(F%) 
  4881.  $eind%=$Rf%(F%)
  4882.  row%>Rows% 
  4883.  rel%=0 
  4884. restore(F%," ("+name$+")",5):=
  4885.  row%>Rows% 
  4886. ind%=start%+row%*Rec%
  4887.  I%=0 
  4888.  TabFields%
  4889. ,  rel%(I%)=ind%:ind%+=tabfieldlen%(I%)+1
  4890.  exp%>=0 
  4891.  expand$=$eind%:
  4892. (expand$)<=len%(F%) 
  4893.  $Rf%(F%)=expand$:
  4894. redraw_icon(mainW%,field%(F%))
  4895.     =row%
  4896. check_val(C$,N$)
  4897.  min$,max$,P%,V,ok%
  4898.     ok%=
  4899.  N$="" 
  4900.  C$<>"" 
  4901.   P%=
  4902. C$,"|")
  4903.  P%>0 
  4904.     min$=
  4905. C$,P%-1)
  4906.     max$=
  4907. C$,P%+1)
  4908. H    
  4909.  min$<>"" 
  4910. (min$) 
  4911.  ok%=
  4912. restore(F%," (min="+min$+")",58)
  4913. H    
  4914.  max$<>"" 
  4915. (max$) 
  4916.  ok%=
  4917. restore(F%," (max="+max$+")",59)
  4918. restore_rec
  4919.  F%=1 
  4920.  fields%
  4921.   $Rf%(F%)=field$(F%)
  4922. redraw(mainW%)
  4923. restore(F%,E$,E%)
  4924.  E%>=0 
  4925. softerror(E$,E%)
  4926. $Rf%(F%)=field$(F%)
  4927. redraw_icon(mainW%,field%(F%))
  4928. set_caret(mainW%,field%(F%))
  4929. relations(menu%)
  4930.  F%,I%,W%,L%,N$,row%,col%,flags%
  4931. &    F%=-1
  4932. '&row%=
  4933. validate(Fieldnumber%,F%,N$)
  4934. (!col%=
  4935. link$(Fieldnumber%)))
  4936.  row%>0 
  4937. delete_icons(relateW%,0)
  4938.  I%=0 
  4939. ,7    
  4940.  I%=col% 
  4941.  flags%=&0B000531 
  4942.  flags%=&07000531
  4943.     L%=
  4944. ($rel%(I%))
  4945. .T    R%=
  4946. create_icon(relateW%,0,-I%*36-36,L%*16+16,32,flags%,"",rel%(I%),-1,L%+1)
  4947.  L%>W% 
  4948.  W%=L%
  4949.   $RelTitle%=N$
  4950.  menu% 
  4951.     xmax%=x%-32:ymax%=y%
  4952. 4        
  4953. 59    !block%=keypadW%:
  4954.  "Wimp_GetWindowState",,block%
  4955. 6)    xmax%=block%!12+2:ymax%=block%!16
  4956. 87  !block%=relateW%:
  4957.  "Wimp_GetWindowState",,block%
  4958. 9&  width%=W%*16+16:height%=F%*36+36
  4959. :+  block%!4=xmax%:block%!12=xmax%+width%
  4960. ;,  block%!8=ymax%-height%:block%!16=ymax%
  4961.   block%!28=-1
  4962.  menu% 
  4963. >$    
  4964.  "Wimp_OpenWindow",,block%
  4965. ?/    
  4966.  "Wimp_CreateMenu",,relateW%,x%-32,y%
  4967. @        
  4968. A$    
  4969.  "Wimp_OpenWindow",,block%
  4970. redraw(relateW%)
  4971. close_window(relateW%)
  4972. fix_point(F$,F%)
  4973.  F$="" 
  4974. @%=&01020009+fix%(F%)*256
  4975. (F$))
  4976. @%=&90A
  4977. F$,len%(F%))
  4978. moveto(key%,P%,D%)
  4979. D%=(D%+1) 
  4980.  filter% 
  4981. R#  P%=
  4982. next_match(P%,D%,Filter$)
  4983.   P%=
  4984. neighbour(key%,P%,D%)
  4985.  P%=top 
  4986.  7:P%=
  4987. neighbour(key%,P%,D%)
  4988. display(key%,P%)
  4989. next_match(P%,D%,S$)
  4990.  REC%
  4991. \*dbasehandle%=
  4992. ($database%+".Database")
  4993.   P%=
  4994. neighbour(key%,P%,D%)
  4995.  P%<>top 
  4996. `     REC%=
  4997. rec_no(k$,key%,P%)
  4998. a'    
  4999. readsmarray(dbasehandle%,REC%)
  5000. (S$)=
  5001.  P%=top
  5002.  P%=top 
  5003. softerror("",38)
  5004. close_file(dbasehandle%)
  5005. display(key%,P%)
  5006. check_change
  5007.  template%=1 
  5008.  template%=2 
  5009.  template%=0
  5010.  I%,L%,S%,S$,k$,ok%,nextrec%
  5011. nP  keybase%=!keyanchor%(key%):A%=!keybase%:nextrec%=!(keybase%+A%+8+KL%(0)+1)
  5012. p6    
  5013.  !(keybase%+A%)>0,template%=2,design%=
  5014. :ok%=
  5015.     incr%=
  5016. ($Increment%)
  5017.  incr%>0 
  5018. t+      
  5019. change_length(RA%+incr%,
  5020. ):ok%=
  5021.       
  5022. softerror("",2)
  5023. v        
  5024.  ok% 
  5025. z:      
  5026.  design%:$RecInfo%="Make adjustments to fields"
  5027. {a      
  5028.  template%=2:$RecInfo%="Enter data which you want to appear by default on new records"
  5029. |"      
  5030. :$RecInfo%="New record"
  5031. }        
  5032. ~1    REC%=RA%:
  5033. read(fields%,
  5034. ,REC%,$database%)
  5035.  top:
  5036. /  REC%=RA%:
  5037. read(fields%,
  5038. ,REC%,$database%)
  5039. #  $RecInfo%="Subfile="+
  5040. (file%)
  5041.  filter% 
  5042.  7:$RecInfo%+=". (Empty)"
  5043.   REC%=
  5044. rec_no(k$,key%,P%)
  5045. read(fields%,
  5046. ,REC%,$database%)
  5047.   key$(key%)=k$
  5048. K  $RecInfo%="Subfile="+
  5049. (file%)+". Record="+
  5050. (REC%)+". Key="+key$(key%)
  5051. text_length(mainW%,starthere%)
  5052.  Access% 
  5053. set_caret(mainW%,starthere%)
  5054. identify_field(starthere%)
  5055. update_calcs(0)
  5056. selected(passW%,16) 
  5057.  logentry$="Subfile "+
  5058. (file%)+"  "+$Rf%(KF%(0,0))+" "+$Rf%(KF%(0,1))
  5059. redraw(mainW%)
  5060.  -------------------- Icon colours -------------------------------
  5061. colour(key%,type%)
  5062. change_field_cols(key%,type%,0)
  5063.  KF%(key%,1)>0 
  5064. change_field_cols(key%,type%,1)
  5065. change_field_cols(key%,type%,fld%)
  5066. col%=fcol%(type%*2)
  5067.  type%=0 
  5068.  key%>0 
  5069.  (key%=0 
  5070.  fcol%(0)=&17) 
  5071. set_icon_cols(mainW%,desc%(KF%(key%,fld%)),col%)
  5072. col%=fcol%(type%*2+1)
  5073. 7col2%=
  5074. get_icon_cols(mainW%,field%(KF%(key%,fld%)))
  5075.  (col2% 
  5076.  %1111)<>fcol%(6) 
  5077.  type%=0 
  5078.  key%>0 
  5079.  (key%=0 
  5080.  fcol%(1)=&07) 
  5081. set_icon_cols(mainW%,field%(KF%(key%,fld%)),col%)
  5082. get_icon_cols(wi%,ic%)
  5083. ;!block%=wi%:block%!4=ic%:
  5084.  "Wimp_GetIconState",,block%
  5085. =block%?27
  5086. set_icon_cols(wi%,ic%,col%)
  5087. D!block%=wi%:block%!4=ic%:block%!8=(col%<<24):block%!12=&FF000000
  5088.  "Wimp_SetIconState",,block%
  5089. dcolour(wi%,ic%,col%,fb%)
  5090. ;!block%=wi%:block%!4=ic%:
  5091.  "Wimp_GetIconState",,block%
  5092.  fb% 
  5093.  0:block%!8=col%<<28:block%!12=&F0000000
  5094.  1:block%!8=col%<<24:block%!12=&0F000000
  5095.  "Wimp_SetIconState",,block%
  5096. read_colours(f$)
  5097.  ic%=0 
  5098. #F,fcol%(ic%)
  5099. ncol%()=fcol%()
  5100. close_file(F)
  5101. write_colours
  5102. ($database%+".Colours")
  5103.  ic%=0 
  5104. #F,fcol%(ic%)
  5105. close_file(F)
  5106. find(S$,key%,m%,disp%)
  5107.  P%,F%,H%,num%,abort%,cond$
  5108.  case%(key%) 
  5109. u(S$)
  5110. S$,1)="#" 
  5111. check_change
  5112.   REC%=
  5113. S$,2))
  5114.  REC%>=0 
  5115.  REC%<RA% 
  5116. (    
  5117. read(fields%,
  5118. ,REC%,$database%)
  5119. !    S$=key$(key%):H%=1:num%=
  5120. 3    
  5121. select(keypadW%,25):
  5122. deselect(keypadW%,24)
  5123. -    
  5124. softerror(" ("+S$+")",56):abort%=
  5125.  abort% 
  5126. =addr
  5127. val$=
  5128. type(key%)
  5129.  val$="VAL" 
  5130.   kl%=KL%(key%)
  5131.   P%=
  5132. S$," ")
  5133.  P%>0 
  5134. S$,P%-1)
  5135.   kl%=
  5136. search(S$,key%,1+H%)
  5137.  P%<0 
  5138. selected(keypadW%,25) 
  5139.   F%=file%
  5140.     file%=(file%+1) 
  5141.     top=8*file%+LH%
  5142.      P%=
  5143. search(S$,key%,1+H%)
  5144.  P%>0 
  5145.  file%=F%
  5146.  val$="VAL" 
  5147.  cond$="VAL($(!keyanchor%(key%)+P%+8))=VAL(S$)" 
  5148.  cond$="LEFT$($(!keyanchor%(key%)+P%+8),kl%)=S$"
  5149. matches%=0
  5150.  P%>=0 
  5151.  num%:RecF%=
  5152. :addr=P%
  5153.  P%>=0:RecF%=
  5154. (cond$)
  5155.      P%=
  5156. neighbour(key%,P%,0)
  5157. \  P%=
  5158. neighbour(key%,P%,1):addr=P%:
  5159.  ### Scan back to FIRST match & point addr at it ###
  5160. (cond$)
  5161.     matches%+=1
  5162.      P%=
  5163. neighbour(key%,P%,1)
  5164.  num%:
  5165. softerror(" (#"+
  5166. (REC%)+")",55)
  5167.  7:flash%=KF%(key%,0):addr=
  5168. text(keypadW%,36)=
  5169. (matches%)+" found":
  5170. redraw_icon(keypadW%,36)
  5171.  disp% 
  5172. display(key%,addr)
  5173.     =addr
  5174. get_it_in(filename$)
  5175.  "OS_File",5,filename$ 
  5176.  d%,,ftype%
  5177. ftype%=(ftype%>>8) 
  5178.  &FFF
  5179.  ftype% 
  5180.  &7f1:
  5181.  LastTable%=MaxTabs% 
  5182. softerror(
  5183. (MaxTabs%+1),32) 
  5184. drag_table(filename$):
  5185. show_table(Tablenumber%)
  5186.  &7f3:
  5187. drag_selection(filename$)
  5188.  &7f4:
  5189. drag_query(filename$)
  5190.  &7f5:
  5191. drag_options(filename$)
  5192.  &dfe:
  5193. start_import("CSV",block%!20)
  5194.  &ff9,&aff:
  5195. transfer_blob(block%!20,block%!24,REC%,filename$,ftype%)
  5196.  &fff:
  5197. /  F=
  5198. (filename$):header$=
  5199. close_file(F)
  5200.     &    
  5201.  header$="!SCRIPT POWERBASE":
  5202. /    
  5203.  present%=7 
  5204. execute_file(filename$)
  5205.  block%!24>0:
  5206. A    
  5207. transfer_blob(block%!20,block%!24,REC%,filename$,ftype%)
  5208. )    
  5209. start_import("text",block%!20)
  5210.  block%!20 
  5211.  reformW%:
  5212.  reform$ 
  5213. 1      
  5214.  "Merge":
  5215. merge_files(filename$,file%)
  5216. +      
  5217.  "Reformat":
  5218. reformat(filename$)
  5219.         
  5220.  d%=2 
  5221. #      
  5222. leaf(filename$),1) 
  5223.         
  5224.  "!":
  5225. 3        
  5226.  ### Is it an Impression document? ###
  5227. 5        
  5228.  "OS_File",5,filename$+".!DocData" 
  5229.         
  5230.  d%=1 
  5231. (          document$=
  5232. leaf(filename$)
  5233. ;          
  5234. document$,1)="!" 
  5235.  document$=
  5236. document$,2)
  5237. >          block%!0=256:block%!12=0:block%!16=5:block%!20=0
  5238.  =          block%!24=0:block%!28=0:block%!32=0:block%!36=0
  5239. !4          block%!40=&2000:$(block%+44)=filename$
  5240. "/          
  5241.  "Wimp_SendMessage",18,block%,0
  5242. #6          mergewith$="Impression":Impref%=block%!8
  5243. $8          $MergeTitle%="Data merge with "+mergewith$
  5244.           
  5245. &6          
  5246.  ### Is it a Powerbase application? ###
  5247. '6          
  5248.  "OS_File",5,filename$+".Indices" 
  5249.           
  5250.  d%=2 
  5251. )$            
  5252.  present%>0 
  5253. *(            $Title%=
  5254. leaf(filename$)
  5255. +&            
  5256. open_files(filename$)
  5257.           
  5258.         
  5259.         
  5260. /7        
  5261.  ### It's an ordinary directory folder ###
  5262. 0A        
  5263. transfer_blob(block%!20,block%!24,REC%,filename$,-1)
  5264.       
  5265. 2        
  5266. open_files(f$)
  5267.  I%,J%,F%,A$
  5268.  "OS_File",5,f$+".Dbase" 
  5269.  d%=1 
  5270.  fatal_err%,
  5271. msg(42)
  5272.  "OS_File",5,f$+".Database" 
  5273.  d%=1 
  5274.  present%=present% 
  5275.  "OS_File",5,f$+".PrimaryKey" 
  5276.  d%=1 
  5277.  present%=present% 
  5278.  "OS_File",5,f$+".Form" 
  5279.  d%=1 
  5280.  present%=present% 
  5281.  "OS_File",5,f$+".UsrSprites" 
  5282.  d%,,,,len%
  5283.  d%=1 
  5284. create_named_sliding_block(logoanchor%,len%+8)
  5285. D&  base%=!logoanchor%:!base%=len%+4
  5286.  "OS_File",255,f$+".UsrSprites",base%+4
  5287.   logosloaded%=
  5288.  "OS_CLI","Set DBase$Dir "+f$
  5289. $database%=f$
  5290.  present% 
  5291.  0,1,5:Access%=
  5292. :Modify%=
  5293. resume_opening
  5294. access(f$)
  5295. wimp_error(
  5296. ,254,0,
  5297. msg(24))
  5298. access(f$)
  5299.  L%,P%,keybase%
  5300. (f$+".Colours")
  5301.  F=0 
  5302.  fatal_err%,f$+"."+
  5303. msg(18)
  5304. #F=35
  5305. #F,S$:$Read%=
  5306. encrypt(S$,
  5307. #F,S$:$Write%=
  5308. encrypt(S$,
  5309. #F,S$:$Manager%=
  5310. encrypt(S$,
  5311.  I%=9 
  5312. select(passW%,I%)
  5313. deselect(passW%,16)
  5314.  I%<17 
  5315. #F,Z%:
  5316. set_icon(passW%,I%,Z%)
  5317.   I%+=1
  5318. #F,logpath$
  5319. close_file(F)
  5320.  $Manager%="" 
  5321.   Access%=
  5322. :Modify%=
  5323. :pw%=0
  5324. resume_opening
  5325. h;  $AccessTitle%="!Powerbase opening "+
  5326. leaf($database%)
  5327. open_window(accessW%)
  5328.   $Password%=""
  5329. set_caret(accessW%,0)
  5330.  "Wimp_GetWindowState",,block%
  5331.  block%!4,block%!8,block%!12-block%!4,block%!16-block%!8
  5332.   act%=0
  5333.  accessbutton%>0
  5334.  accessbutton% 
  5335. t#    
  5336. close_window(accessW%)
  5337. u)    present%=
  5338. :accessbutton%=0:act%=1
  5339. w     password$=
  5340. u($Password%)
  5341.  password$ 
  5342. y6      
  5343.  $Manager%:Access%=
  5344. :Modify%=
  5345. :act%=2:pw%=3
  5346. z4      
  5347.  $Write%:Access%=
  5348. :Modify%=
  5349. :act%=2:pw%=2
  5350. {3      
  5351.  $Read%:Access%=
  5352. :Modify%=
  5353. :act%=2:pw%=1
  5354.       
  5355. :accessbutton%=0:
  5356. }1      $
  5357. text(accessW%,1)="Password not known"
  5358. ~#      
  5359. dcolour(accessW%,1,11,1)
  5360.       delay%=
  5361.       
  5362.         
  5363.       
  5364. >delay%
  5365. G      $Password%="":
  5366. redraw_icon(accessW%,0):
  5367. set_caret(accessW%,0)
  5368. 4      $
  5369. text(accessW%,1)="Type in your password"
  5370. "      
  5371. dcolour(accessW%,1,7,1)
  5372.         
  5373.  act%>0
  5374. close_window(accessW%)
  5375. getscreensize(W%,H%)
  5376.  0,0,W%,H%
  5377.  act%=2 
  5378. resume_opening
  5379. resume_opening
  5380.  "Hourglass_On"
  5381. selected(passW%,16) 
  5382. open_log
  5383.  "OS_File",5,f$+".UserFuncs" 
  5384.  d%=1 
  5385.  f$+".UserFuncs"
  5386. read_colours($database%+".Colours")
  5387.  "OS_File",5,f$+".PrintRes.PrintOpts" 
  5388.  d%=1 
  5389. drag_options(f$+".PrintRes.PrintOpts")
  5390. drag_options("<Pbase$Dir>.Resources.PrintOpts")
  5391. f$,3)="RAM" 
  5392.  ram%=
  5393. 9*Set Alias$Tables Filer_OpenDir <Dbase$Dir>.ValTables
  5394. ;*Set Alias$Resources Filer_OpenDir <Dbase$Dir>.PrintRes
  5395. ;*Set Alias$JobsDone Filer_OpenDir <Dbase$Dir>.PrintJobs
  5396. lit(menu%(0),1,
  5397. lit(menu%(0),3,
  5398. lit(menu%(1),6,
  5399. selected(passW%,9))
  5400. lit(menu%(3),8,
  5401. selected(passW%,15))
  5402. lit(menu%(7),0,Access%)
  5403. lit(menu%(7),1,Modify%)
  5404. lit(menu%(7),2,Access%)
  5405. lit(menu%(7),3,Access%)
  5406. lit(menu%(7),4,Access%)
  5407. lit(menu%(2),0,Access%)
  5408. lit(menu%(0),2,Modify%)
  5409. lit(menu%(10),0,Access%)
  5410. lit(menu%(10),2,Access%)
  5411. lit(menu%(10),3,Access%)
  5412. lit(menu%(13),0,Access%)
  5413. lit(menu%(17),0,Modify%)
  5414. lit(menu%(3),0,((present% 
  5415.  4)>0))
  5416. lit(menu%(9),1,((present% 
  5417.  4)=0))
  5418.  I%=1 
  5419. lit(menu%(3),I%,(present%=7))
  5420. limit_actions(Access%)
  5421.  present%<4 
  5422.  design%=
  5423.  present%=5 
  5424. adjust_on(
  5425. lit(menu%(9),5,
  5426. fields%=
  5427. get_form(Fptr%)
  5428.  fields%>0 
  5429. %  starthere%=field%(
  5430. first_field)
  5431. field_menu(fieldmenu%,fields%)
  5432. create_named_sliding_block(transanchor%,Length%+1)
  5433.  adjust% 
  5434. lit(menu%(9),2,(fields%>0))
  5435. load_calcs
  5436.  present% 
  5437. -  $RecInfo%="No record design exists yet"
  5438.  I%=1 
  5439. lit(menu%(9),I%,
  5440. open_window(mainW%)
  5441.  !formanchor%=0 
  5442. 2    
  5443. extend_named_sliding_block(formanchor%,0)
  5444.     Fptr%=!formanchor%
  5445.      fields%=0:Fieldnumber%=0
  5446. 8  $RecInfo%="Record design exists, but no datafiles"
  5447. first_field>0 
  5448. lit(menu%(9),3,
  5449. lit(menu%(9),4,
  5450. open_window(mainW%)
  5451. 6  $RecInfo%="No primary key index file exists yet"
  5452.  "OS_File",5,$database%+".Database" 
  5453.  ,,,,len%
  5454. -  RA%=(len% 
  5455.  Length%)-1:$Records%=
  5456. (RA%)
  5457. first_field>0 
  5458. open_window(mainW%)
  5459. lit(menu%(1),7,
  5460. selected(passW%,13))
  5461. lit(menu%(1),8,
  5462. selected(passW%,13))
  5463. lit(menu%(1),2,
  5464. selected(passW%,14))
  5465.  "OS_File",5,$database%+".Database" 
  5466.  ,,,,len%
  5467. -  RA%=(len% 
  5468.  Length%)-1:$Records%=
  5469. (RA%)
  5470. open_index($database%+".PrimaryKey",0)
  5471. $  key%=0:file%=0:top=8*file%+LH%
  5472. set_keydata(key%)
  5473. l  keybase%=!keyanchor%(0):
  5474.  keybase%!4<=100 
  5475.  keybase%!4>0 
  5476.  $Increment%=
  5477. (keybase%!4) 
  5478.  $Increment%="0"
  5479. ,  f$=$database%+".Indices":R4%=0:Keys%=0
  5480.  R4%<>-1
  5481.     Keys%+=1
  5482. 5    
  5483.  "OS_GBPB",9,f$,block%,1,R4%,11 
  5484.  ,,K$,,R4%
  5485. A    
  5486.  R4%<>-1 
  5487. open_index(f$+"."+K$,Keys%):
  5488. colour(Keys%,2)
  5489.   Keys%-=1
  5490.  extrakeys$<>"" 
  5491. softerror(
  5492. extrakeys$),96)
  5493. colour(0,0):
  5494. colour(0,1)
  5495. get_tables
  5496.   key%=0
  5497. count(key%,RU%)
  5498. show_windows
  5499.  "Hourglass_Off"
  5500. $dbase%=
  5501. $Title%,2)
  5502. redraw_icon(-2,pbaseicon%)
  5503. f$=$database%+".Choices"
  5504.  "OS_File",5,f$ 
  5505.  d%=1 
  5506. get_choices(f$)
  5507.  "OS_File",5,$database%+".Special" 
  5508.  d%=1 
  5509.  $database%+".Special":
  5510. customise
  5511. val(keypadW%,17)
  5512. $,5,6)="01 Apr" 
  5513. $,17,2)<"12" 
  5514. !  S$="Stoilet"+
  5515. $block%!32,8)
  5516.  S$="Sdelete"+
  5517. $block%!32,8)
  5518. val(keypadW%,17)=S$
  5519. get_choices(f$)
  5520.  F,S$,C$,P%
  5521. 2  S$=
  5522. #F:P%=
  5523. S$," "):C$=
  5524. S$,P%+1):S$=
  5525. S$,P%-1)
  5526. D    
  5527.  "Validate":validate%=(C$="ON"):
  5528. tick(menu%(2),3,validate%)
  5529. G    
  5530.  "Relations":relations%=(C$="ON"):
  5531. tick(menu%(2),4,relations%)
  5532. B    
  5533.  "Warning":delwarn%=(C$="ON"):
  5534. tick(menu%(10),7,delwarn%)
  5535.  "Autosave":
  5536. C$,4) 
  5537. .      
  5538.  "OFF ":mode%=0:$Interval%="10 min"
  5539. ,      
  5540.  "WARN":mode%=1:$Interval%=
  5541. C$,5)
  5542. ,      
  5543.  "AUTO":mode%=2:$Interval%=
  5544. C$,5)
  5545.         
  5546. set_auto(mode%)
  5547.  "Autobalance":
  5548. C$,4) 
  5549. &      
  5550.  "OFF ":
  5551. set_autobalance(
  5552. 5      
  5553.  "AUTO":$Every%=
  5554. C$,5):
  5555. set_autobalance(
  5556.         
  5557.  "Separator":
  5558.     $Delim%=""
  5559. !      
  5560.  "Comma":sep$=",":P%=0
  5561.        
  5562.  "TAB":sep$=
  5563. (9):P%=1
  5564.        
  5565.  "CR":sep$=
  5566. (13):P%=2
  5567.        
  5568.  "LF":sep$=
  5569. (10):P%=3
  5570.  #      
  5571.  $Delim%=C$:sep$=C$:P%=4
  5572. !        
  5573. "#    
  5574. tick_one(menu%(15),0,3,P%)
  5575. #2    $
  5576. text(csvW%,14)=C$:
  5577. redraw_icon(csvW%,14)
  5578.  "Terminator":
  5579.     $Termin%=""
  5580. '!      
  5581.  "CR":term$=
  5582. (13):P%=0
  5583. (!      
  5584.  "LF":term$=
  5585. (10):P%=1
  5586. )*      
  5587.  "CR LF":term$=
  5588. (13)+
  5589. (10):P%=2
  5590. **      
  5591.  "LF CR":term$=
  5592. (10)+
  5593. (13):P%=3
  5594. +*      
  5595.  "CR CR":term$=
  5596. (13)+
  5597. (13):P%=4
  5598. ,*      
  5599.  "LF LF":term$=
  5600. (10)+
  5601. (10):P%=5
  5602. -&      
  5603. : $Termin%=C$:term$=C$:P%=6
  5604. .        
  5605. /#    
  5606. tick_one(menu%(20),0,5,P%)
  5607. 02    $
  5608. text(csvW%,15)=C$:
  5609. redraw_icon(csvW%,15)
  5610. 1-    
  5611.  "Quotes":
  5612. set_icon(csvW%,0,C$="ON")
  5613. 2-    
  5614.  "Header":
  5615. set_icon(csvW%,1,C$="ON")
  5616. 3-    
  5617.  "Blanks":
  5618. set_icon(csvW%,2,C$="ON")
  5619. 4*    
  5620.  "Key":
  5621. set_icon(csvW%,3,C$="ON")
  5622. 5B    
  5623.  "Data":
  5624. set_icon(csvW%,4,(C$="ON" 
  5625. selected(csvW%,1)))
  5626. 6/    
  5627.  "Display":
  5628. set_icon(csvW%,11,C$="ON")
  5629. 7-    
  5630.  "Strip":
  5631. set_icon(csvW%,16,C$="ON")
  5632.  "CaseSpecific":
  5633. 9'    
  5634. set_icon(matchW%,16,(C$="ON"))
  5635. :(    
  5636. set_icon(savesubW%,5,(C$="ON"))
  5637. ;'    
  5638. set_icon(changeW%,5,(C$="ON"))
  5639. <%    
  5640. set_icon(moveW%,9,(C$="ON"))
  5641. ='    
  5642. set_icon(mergeW%,12,(C$="ON"))
  5643. >(    
  5644. set_icon(keypadW%,32,(C$="ON"))
  5645.  "Duplication":
  5646. @-    dup%=(C$="ON"):
  5647. tick(menu%(3),8,dup%)
  5648. icon_bit(22,csvW%,4,(
  5649. selected(csvW%,1)))
  5650. close_file(F)
  5651. save_choices(f$)
  5652.  F,C$
  5653.  validate%=
  5654.  C$="ON" 
  5655.  C$="OFF"
  5656. #F,"Validate "+C$
  5657.  relations%=
  5658.  C$="ON" 
  5659.  C$="OFF"
  5660. #F,"Relations "+C$
  5661.  delwarn%=
  5662.  C$="ON" 
  5663.  C$="OFF"
  5664. #F,"Warning "+C$
  5665.  autosave% 
  5666.  0:C$="OFF "
  5667.  1:C$="WARN"+$Interval%
  5668.  2:C$="AUTO"+$Interval%
  5669. #F,"Autosave "+C$
  5670.  autobalance% 
  5671.  0:C$="OFF "
  5672.  1:C$="AUTO"+$Every%
  5673. #F,"Autobalance "+C$
  5674. selected(csvW%,0) 
  5675.  C$="ON" 
  5676.  C$="OFF"
  5677. #F,"Quotes "+C$
  5678. selected(csvW%,1) 
  5679.  C$="ON" 
  5680.  C$="OFF"
  5681. #F,"Header "+C$
  5682. selected(csvW%,2) 
  5683.  C$="ON" 
  5684.  C$="OFF"
  5685. #F,"Blanks "+C$
  5686. selected(csvW%,3) 
  5687.  C$="ON" 
  5688.  C$="OFF"
  5689. #F,"Key "+C$
  5690. selected(csvW%,4) 
  5691.  C$="ON" 
  5692.  C$="OFF"
  5693. #F,"Data "+C$
  5694.  sep$ 
  5695.  ",":C$="Comma"
  5696. (9):C$="TAB"
  5697. (10):C$="LF"
  5698. (13):C$="CR"
  5699. :C$=sep$
  5700. #F,"Separator "+C$
  5701.  term$ 
  5702. (13):C$="CR"
  5703. (10):C$="LF"
  5704. (13)+
  5705. (10):C$="CR LF"
  5706. (10)+
  5707. (13):C$="LF CR"
  5708. (13)+
  5709. (13):C$="CR CR"
  5710. (10)+
  5711. (10):C$="LF LF"
  5712. :C$=term$
  5713. #F,"Terminator "+C$
  5714. selected(csvW%,11) 
  5715.  C$="ON" 
  5716.  C$="OFF"
  5717. #F,"Display "+C$
  5718. selected(csvW%,16) 
  5719.  C$="ON" 
  5720.  C$="OFF"
  5721. #F,"Strip "+C$
  5722. selected(matchW%,16),
  5723. selected(savesubW%,5),
  5724. selected(changeW%,5),
  5725. selected(moveW%,9),
  5726. selected(mergeW%,12),
  5727. selected(keypadW%,32):C$="ON"
  5728. :C$="OFF"
  5729. #F,"CaseSpecific "+C$
  5730.  dup% 
  5731.  C$="ON" 
  5732.  C$="OFF"
  5733. #F,"Duplication "+C$
  5734. close_file(F)
  5735.  "OS_File",18,f$,&fff
  5736. open_index(f$,key%)
  5737.  keybase%,I%
  5738.  key%>MaxKeys% 
  5739.  extrakeys$+=
  5740. leaf(f$)+",":Keys%-=1:
  5741.  keyanchor%(key%) 
  5742. scrap_sliding_block(keyanchor%(key%))
  5743.  "OS_File",5,f$ 
  5744.  ,,,,len%
  5745. create_named_sliding_block(keyanchor%(key%),len%)
  5746.  "OS_File",255,f$,!keyanchor%(key%)
  5747. Index$(key%)=
  5748. leaf(f$)
  5749. keybase%=!keyanchor%(key%)
  5750.  key%=0 
  5751.  I%=0 
  5752. %    $Date%(I%)=$(keybase%+8+9*I%)
  5753. KF%(key%,0)=keybase%!62
  5754. KF%(key%,1)=keybase%!66
  5755. KL%(key%)=keybase%?70
  5756. !case%(key%)=(keybase%?71=255)
  5757.  I%=0 
  5758. &  KW%(key%,I%)=!(keybase%+74+I%*4)
  5759. get_tables
  5760.  lk,F%,d%,R4%,f$,name$
  5761. $f$=$database%+".ValTables":R4%=0
  5762.  "OS_File",5,$database%+".Tables" 
  5763.  d%=2 
  5764.  fatal_err%,
  5765. msg(18)
  5766. close_file(lk):
  5767. wimp_error(
  5768. ($database%+".Link")
  5769.  lk>0 
  5770.   !block%=mainW%
  5771.     F%+=1
  5772. #lk,link$(F%)
  5773.     name$=
  5774. link$(F%))
  5775. name$,1)<>"@" 
  5776.       
  5777.  name$<>"" 
  5778. +        
  5779. (name$)<58 
  5780.  name$=
  5781. name$,2)
  5782. 6        
  5783. set_icon_cols(mainW%,field%(F%),fcol%(6))
  5784. .        
  5785.  d%=0 
  5786. drag_table(f$+"."+name$)
  5787.       
  5788.         
  5789.   link$(0)="LOADED"
  5790. close_file(lk)
  5791.  ### Force loading of unlinked but flagged tables ###
  5792.  R4%<>-1
  5793.  "OS_GBPB",9,f$,block%,1,R4%,11 
  5794.  ,,name$,,R4%
  5795.  R4%<>-1 
  5796. name$)="!" 
  5797. drag_table(f$+"."+name$)
  5798.  extratabs$<>"" 
  5799. softerror(
  5800. extratabs$),97)
  5801. load_calcs
  5802.  F%,F1%,P%,calc$
  5803. update$()=""
  5804. ($database%+".Calc")
  5805.  cl>0 
  5806. +    F%+=1:F$=
  5807. ~(F%):
  5808.  F%<16 
  5809.  F$="0"+F$
  5810. "    
  5811. #cl,calc$:calc$(F%)=calc$
  5812.  chartype%(F%) 
  5813.       
  5814.  6,7:
  5815.       
  5816. !        P%=
  5817. calc$,"$Rf%(",P%)
  5818. ?        
  5819.  P%>0 
  5820.  F1%=
  5821. calc$,P%+5)):update$(F1%)+=F$:P%+=5
  5822.       
  5823.  P%=0
  5824.       
  5825.          P%=
  5826. calc$,"FNn(",P%)
  5827. ?        
  5828.  P%>0 
  5829.  F1%=
  5830. calc$,P%+4)):update$(F1%)+=F$:P%+=4
  5831.       
  5832.  P%=0
  5833. .      
  5834. calc$,"TIME$")>0 
  5835.  update$(0)+=F$
  5836.         
  5837.   calc$(0)="LOADED"
  5838. close_file(cl)
  5839. get_form(
  5840.  Fptr%)
  5841.  F,L%,N%,I%,V%,x%,y%,xlim%,ylim%,text%
  5842. buttonfield%()=0
  5843.  design% 
  5844.  dflg%=(winback%<<28)+&7016731:dval%=hand%:func%=1 
  5845.  dflg%=(winback%<<28)+&7010731:dval%=-1:func%=0
  5846. ($database%+".Form")
  5847.  F>0 
  5848. #F,N%
  5849.  N%>127 
  5850.  fatal_err%,
  5851. msg(98)
  5852. 2  formlen%=&100:forminc%=formlen%:form_incs%=0
  5853. extend_named_sliding_block(formanchor%,formlen%)
  5854. 9  Fptr%=!formanchor%:Rf%(0)=Fptr%:$Rf%(0)="":Fptr%+=1
  5855.   Length%=0
  5856.  I%=1 
  5857. @    
  5858. #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%,char%,fix%,bbox%
  5859. /      
  5860.  bbox%=0 
  5861.  len%=0:width%=0:height%=0
  5862. 0      
  5863.  bbox%=0:width%=len%*16+16:height%=48
  5864. 6      
  5865.  bbox%<&10000:width%=bbox%*16+16:height%=48
  5866. 2      
  5867. :width%=bbox% 
  5868.  &FFFF:height%=bbox%>>16
  5869.         
  5870.  design% 
  5871.       
  5872.  char% 
  5873. 1        
  5874.  0,1,2,3,4,5,6,7,8,39,40:fval%=hand%
  5875. "        
  5876. :fval%=hvalid%(char%)
  5877.       
  5878.       
  5879.       
  5880. =        
  5881.  char%>8 
  5882.  char%<32:fval%=
  5883. val(keypadW%,char%-9)
  5884. !        
  5885. :fval%=valid%(char%)
  5886.       
  5887.         
  5888. "    x%=xf%+width%+32:y%=yf%-16
  5889.  x%>xlim% 
  5890.  xlim%=x%
  5891.  y%<ylim% 
  5892.  ylim%=y%
  5893. '    y%=yd%-16:
  5894.  y%<ylim% 
  5895.  ylim%=y%
  5896.     Length%+=len%+1
  5897. F    
  5898.  design%=
  5899.  char%=39 
  5900.  len%=(height% 
  5901.  40)*((width% 
  5902.  16)-4)
  5903. 7    len%(I%)=len%:chartype%(I%)=char%:fix%(I%)=fix%
  5904.     L%=
  5905. (Desc$)
  5906. 1    
  5907.  Fptr%-!formanchor%+L%+len%+2>formlen% 
  5908. *      form_incs%+=1:formlen%+=forminc%
  5909. ;      
  5910. extend_named_sliding_block(formanchor%,formlen%)
  5911.         
  5912.     $Fptr%=Desc$
  5913. Q    desc%(I%)=
  5914. create_icon(mainW%,xd%,yd%,L%*16+8,48,dflg%,"",Fptr%,dval%,L%)
  5915. -    Fptr%+=L%+1:Rf%(I%)=Fptr%:$Rf%(I%)=""
  5916. 0    
  5917. icon_design(char%,func%,width%,height%)
  5918. T    
  5919.  char%=59 
  5920.  design% 
  5921.  $Fptr%=Tag$(I%):len%=
  5922. (Tag$(I%)):fval%=!logoanchor%
  5923.     \    field%(I%)=
  5924. create_icon(mainW%,xf%,yf%,width%,height%,iflags%,"",Fptr%,fval%,len%+1)
  5925.  char% 
  5926. h      
  5927.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31:buttonfield%(char%-9)=I%
  5928. 6      
  5929.  40:Rf%(I%)=
  5930. create_anchor("Picture"+
  5931. (I%))
  5932. ?      
  5933.  3,6,46,47,54,56,57:
  5934. icon_bit(9,mainW%,field%(I%),
  5935.         
  5936.     Fptr%+=len%+1
  5937. close_file(F)
  5938. extend_named_sliding_block(formanchor%,Fptr%-!formanchor%):form_incs%+=1
  5939. setup_select(N%)
  5940.  N%=0
  5941.  (present% 
  5942.  4)=0 
  5943.  xlim%=1279:ylim%=-1023
  5944. !block%=0:block%!4=ylim%
  5945. block%!8=xlim%:block%!12=0
  5946.  "Wimp_SetExtent",mainW%,block%
  5947. !block%=mainW%
  5948.  "Wimp_GetWindowState",,block%
  5949. block%!4=0
  5950.  ylim%>-840 
  5951.  block%!8=900+ylim% 
  5952.  block%!8=184
  5953.  xlim%<1240 
  5954.  block%!12=xlim% 
  5955.  block%!12=1240
  5956. block%!16=900
  5957.  "Wimp_OpenWindow",,block%
  5958. setup_select(fields%)
  5959.  S$,I%,J%,Fptr%,rows%
  5960. %&selectlen%=&200:selinc%=selectlen%
  5961. create_named_sliding_block(selanchor%,selectlen%)
  5962. Fptr%=!selanchor%
  5963.  I%=1 
  5964.  fields%
  5965.  Fptr%-!selanchor%+144>selectlen% 
  5966.     selectlen%+=selinc%
  5967. +:    
  5968. extend_named_sliding_block(selanchor%,selectlen%)
  5969.  chartype%(I%) 
  5970.  3,6,8,46,47,54,56,57:
  5971. /#    rows%+=1:
  5972. lit(menu%(6),6,
  5973. 0W    handle%=
  5974. create_icon(pselectW%,16,-rows%*48-56,240,48,&17000531,"",Fptr%,-1,15)
  5975. 1#    S$=$
  5976. text(mainW%,desc%(I%))
  5977. 27    
  5978. (S$)>8 
  5979. S$,8)+"  " 
  5980.  S$+=
  5981. (S$)," ")
  5982. 3-    $Fptr%=S$+Tag$(I%):Fptr%+=
  5983. ($Fptr%)+1
  5984.  J%=0 
  5985. 5b      handle%=
  5986. create_icon(pselectW%,278+J%*112,-rows%*48-52,44,44,&0740B13B,"",Fptr%,tick%,1)
  5987.       $Fptr%="":Fptr%+=1
  5988.     calcrow%?I%=rows%
  5989. :calcrow%?I%=0
  5990. <#!block%=0:block%!4=-rows%*48-56
  5991. block%!8=700:block%!12=0
  5992.  "Wimp_SetExtent",pselectW%,block%
  5993. enable_row(R%,on%)
  5994.  R%>0 
  5995.  I%=R%*5-3 
  5996.  R%*5
  5997. E&    
  5998. icon_bit(22,pselectW%,I%,on%)
  5999. save_form(f$)
  6000.  F,I%,xd%,yd%,xf%,yf%,w%,h%,bbox%,type%
  6001.  fields%=0 
  6002. Length%=0
  6003. !block%=mainW%
  6004. #F,fields%
  6005.  I%=1 
  6006.  fields%
  6007. R(  dicon%=desc%(I%):ficon%=field%(I%)
  6008. S4  block%!4=dicon%:
  6009.  "Wimp_GetIconState",,block%
  6010. T   xd%=block%!8:yd%=block%!12
  6011.   Desc$=$(block%!28)
  6012. V4  block%!4=ficon%:
  6013.  "Wimp_GetIconState",,block%
  6014. W   xf%=block%!8:yf%=block%!12
  6015. X2  w%=block%!16-block%!8:h%=block%!20-block%!12
  6016.   bbox%=(h%<<16)+w%
  6017. #F,Desc$,Tag$(I%),xd%,yd%,xf%,yf%,len%(I%),chartype%(I%),fix%(I%),bbox%
  6018.   Length%+=len%(I%)+1
  6019. \A  field$(I%)="":
  6020.  Rf%(I%)>0 
  6021.  chartype%(I%)<>40 
  6022.  $Rf%(I%)=""
  6023. close_file(F)
  6024.  "OS_File",18,f$,&7f2
  6025. lit(menu%(0),3,
  6026. make_empty_index(RA%,key%,Z%)
  6027.  I%,K%,P%,KLM%,S$
  6028.  "Hourglass_On"
  6029. KL%(key%),".")
  6030. KLM%=KL%(key%)+13
  6031. P%=LH%+48+(RA%+1)*KLM%
  6032. create_named_sliding_block(keyanchor%(key%),P%)
  6033. keybase%=!keyanchor%(key%)
  6034. keybase%!0=138
  6035. keybase%!4=
  6036. ($Increment%)
  6037. $date%=
  6038. (1)):
  6039. date(key%)
  6040. keybase%!62=KF%(key%,0)
  6041. keybase%!66=KF%(key%,1)
  6042. keybase%?70=KL%(key%)
  6043. q#keybase%?71=
  6044. selected(keyW%,20)
  6045. keybase%?72=0:keybase%?73=0
  6046.  I%=0 
  6047. t(  !(keybase%+74+(I%*4))=KW%(key%,I%)
  6048.  I%=0 
  6049.   P%=I%*8+LH%
  6050.   !(keybase%+P%)=-P%
  6051.   !(keybase%+P%+4)=P%
  6052. P%=!keybase%
  6053.  I%=0 
  6054.  RA%-1
  6055.  "Hourglass_Percentage",(I%*100) 
  6056.   !(keybase%+P%)=P%+KLM%
  6057.   !(keybase%+P%+4)=0
  6058.   $(keybase%+P%+8)=S$
  6059. #  !(keybase%+P%+KL%(key%)+9)=I%
  6060.   P%+=KLM%
  6061. !(keybase%+P%)=0
  6062. !(keybase%+P%+4)=0
  6063. $(keybase%+P%+8)=S$
  6064.  !(keybase%+P%+KL%(key%)+9)=0
  6065.  "Hourglass_Off"
  6066. save_recs(f$,RA%)
  6067.  dbasehandle%,I%,J%,rec$
  6068. rec$=
  6069. fields%-1,
  6070. (10))
  6071.  "Hourglass_On"
  6072. dbasehandle%=
  6073.  I%=0 
  6074. #dbasehandle%=I%*Length%
  6075. #dbasehandle%,rec$
  6076.  "Hourglass_Percentage",(I%*100) 
  6077. #dbasehandle%=(RA%+1)*Length%
  6078. close_file(dbasehandle%)
  6079.  "OS_File",18,f$,&7f2
  6080.  "Hourglass_Off"
  6081. clear
  6082.  REC%,action$,ex%,ptr%
  6083. 8Search$=
  6084. parse($
  6085. text(moveW%,7),
  6086. selected(moveW%,9))
  6087.  "Wimp_WhichIcon",moveW%,block%,&003F0000,&00210000
  6088. movetype%=!block%-1
  6089. Title$,". ")+2:Title$=
  6090. Title$,P%)
  6091.  Title$<>"All records" 
  6092.  Title$=" when "+Title$ 
  6093.  Title$=" "+Title$
  6094. 9action$=
  6095. "Move 
  6096. DeleteMove 
  6097. ",movetype%*6+7,6)+Title$
  6098. confirm(action$) 
  6099.  "Hourglass_On"
  6100. *dbasehandle%=
  6101. ($database%+".Database")
  6102. earmark
  6103. close_file(dbasehandle%)
  6104. ptr%=!tempanchor%
  6105. %subtotal%=
  6106. count_recs(key%,zero%)
  6107.  REC%=0 
  6108.  RA%-1
  6109. <  ex%+=1:
  6110.  "Hourglass_Percentage",(ex%*100) 
  6111.  subtotal%
  6112.  ptr%?REC%=255 
  6113. (    
  6114. read(fields%,
  6115. ,REC%,$database%)
  6116. %    addr=
  6117. shift(movetype%,key%,0)
  6118.  REC%
  6119. scrap_sliding_block(tempanchor%)
  6120.  "Hourglass_Off"
  6121.  "Wimp_CreateMenu",,-1
  6122. addr=
  6123. moveto(key%,top,1)
  6124. export_subset(f$)
  6125.  I%,F,R%,recs%,ptr%,count%,subtotal%,blobs%,ex%,Z%,len%,source$,dest$,O$
  6126.  "OS_CLI","Copy "+$database%+".Form "+f$+".Form ~C~V"
  6127.  link$(0)="LOADED" 
  6128.  "OS_CLI","Copy "+$database%+".Link "+f$+".Link ~C~V"
  6129.  calc$(0)="LOADED" 
  6130.  "OS_CLI","Copy "+$database%+".Calc "+f$+".Calc ~C~V"
  6131.  "OS_CLI","Copy "+$database%+".ValTables "+f$+".Valtables ~C~VR"
  6132.  "OS_CLI","Copy "+$database%+".Colours "+f$+".Colours ~CF~V"
  6133.  "OS_File",5,$database%+".UserFuncs" 
  6134.  d%=1 
  6135.  "OS_CLI","Copy "+$database%+".UserFuncs "+f$+".UserFuncs ~CF~V"
  6136.  "OS_File",5,$database%+".UsrSprites" 
  6137.  d%=1 
  6138.  "OS_CLI","Copy "+$database%+".UsrSprites "+f$+".UsrSprites ~CF~V"
  6139.  "Hourglass_On"
  6140. "blobs%=
  6141. find_blobs($database%)
  6142. >Search$=
  6143. parse($
  6144. text(savesubW%,0),
  6145. selected(savesubW%,5))
  6146. *dbasehandle%=
  6147. ($database%+".Database")
  6148. earmark
  6149. (f$+".Database")
  6150. ptr%=!tempanchor%
  6151. %subtotal%=
  6152. count_recs(key%,zero%)
  6153.  I%=0 
  6154.  RA%-1
  6155.  ptr%?I%=255 
  6156.     ex%=-1
  6157.  ex%<blobs%
  6158.       ex%+=1:F%=Ext%(ex%)
  6159. @      
  6160. copy_blob($database%,f$,I%,recs%,F%,F%,chartype%(F%))
  6161.         
  6162. <    
  6163. readsmarray(dbasehandle%,I%):
  6164. writesmarray(F,recs%)
  6165.     count%+=1
  6166. :    
  6167.  "Hourglass_Percentage",(count%*100) 
  6168.  subtotal%
  6169. scrap_sliding_block(tempanchor%)
  6170. =F$()="":
  6171. writesmarray(F,recs%):
  6172. #F=Length%*recs%:recs%-=1
  6173.  K%=0 
  6174.  Keys%
  6175. ,  KL%(MaxKeys%+1)=KL%(K%):val$=
  6176. type(K%)
  6177. !  KF%(MaxKeys%+1,0)=KF%(K%,0)
  6178. !  KF%(MaxKeys%+1,1)=KF%(K%,1)
  6179.  I%=0 
  6180. %    KW%(MaxKeys%+1,I%)=KW%(K%,I%)
  6181. make_empty_index(recs%,MaxKeys%+1,
  6182.  I%=0 
  6183.  recs%-1
  6184. readsmarray(F,I%)
  6185.     KEY$=
  6186. key2(K%,1)
  6187. "    
  6188. insert(
  6189. ,KEY$,MaxKeys%+1)
  6190. 2    
  6191.  "Hourglass_Percentage",(I%*100) 
  6192.  recs%
  6193. &  keybase%=!keyanchor%(MaxKeys%+1)
  6194.  "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(MaxKeys%+1) 
  6195.  ,,filelength%
  6196.  K%>0 
  6197.  index$="Indices." 
  6198.  index$=""
  6199.  "OS_File",10,f$+"."+index$+Index$(K%),&7f0,,keybase%,keybase%+filelength%
  6200. scrap_sliding_block(keyanchor%(MaxKeys%+1))
  6201. close_file(F)
  6202. close_file(dbasehandle%)
  6203.  "OS_File",18,f$+".Database",&7f2
  6204. export%=
  6205.  "Hourglass_Off"
  6206. find_blobs(f$)
  6207.  N%,R4%,S$
  6208.     N%=-1
  6209.  R4%<>-1
  6210.  "OS_GBPB",9,f$,block%,1,R4%,11 
  6211.  ,,S$,,R4%
  6212. S$,4) 
  6213. )    
  6214.  "Memo":N%+=1:Ext%(N%)=
  6215. S$,5))
  6216. )    
  6217.  "Draw":N%+=1:Ext%(N%)=
  6218. S$,5))
  6219. )    
  6220.  "Spri":N%+=1:Ext%(N%)=
  6221. S$,7))
  6222. earmark
  6223.  I%,P%
  6224.  tempanchor% 
  6225. scrap_sliding_block(tempanchor%)
  6226. create_named_sliding_block(tempanchor%,RA%)
  6227. ptr%=!tempanchor%
  6228.  I%=0 
  6229.  RA%-1
  6230.   ptr%?I%=0
  6231. neighbour(key%,top,1)
  6232. scan_file("P%<>top",key%,2)
  6233. rotate
  6234.  Access% 
  6235. confirm(
  6236. msg(49))=
  6237.  keybase%
  6238.  I%,L%,Z%,Q%,R%,S%,key%
  6239.  key%=0 
  6240.  Keys%
  6241.    keybase%=!keyanchor%(key%)
  6242.   S%=LH%+40
  6243.   Z%=keybase%!S%
  6244.  I%=S%-8 
  6245.  S%-40 
  6246. )    L%=keybase%!I%:R%=keybase%!(I%+4)
  6247. =    
  6248.  L%>0 
  6249.  keybase%!(I%+8)=L% 
  6250.  keybase%!(I%+8)=-(I%+8)
  6251.  Z%>0 
  6252.  keybase%!(S%-40)=Z% 
  6253.  keybase%!(S%-40)=-(S%-40)
  6254.  I%=S%-40 
  6255.     Q%=I%-8
  6256.  Q%=S%-48 
  6257.  Q%=S%
  6258. !    PR%=
  6259. neighbour(key%,I%,0)
  6260. !    SU%=
  6261. neighbour(key%,I%,1)
  6262. '    
  6263.  PR%>S% 
  6264.  keybase%!(PR%+4)=-I%
  6265.  #    
  6266.  SU%>S% 
  6267.  keybase%!SU%=-I%
  6268.  key%
  6269. $date%=
  6270. warn%=
  6271. create_index
  6272.  indexing% 
  6273.  printing% 
  6274.  Keys%=MaxKeys% 
  6275. softerror(
  6276. (Keys%),95):
  6277.  file%,top,P%,KEY$,REC%,val$,zero%,abort%,replace%
  6278. newkey%=0
  6279. ,;f$=Tag$(Keyfld0%):
  6280.  Keyfld1%>0 
  6281.  f$+="+"+Tag$(Keyfld1%)
  6282.   newkey%+=1
  6283.  Index$(newkey%)=f$ 
  6284.  newkey%>Keys%
  6285.  newkey%<=Keys%:
  6286. 2     
  6287. confirm(
  6288. msg(50))=
  6289. 33      
  6290. scrap_sliding_block(keyanchor%(newkey%))
  6291.       replace%=
  6292.       
  6293.  abort%=
  6294. 6        
  6295.  Keys%>MaxKeys%:Keys%-=1:
  6296. softerror("",31):abort%=
  6297. :Keys%=newkey%
  6298.  abort% 
  6299. ;*block%!8=0:block%!12=keyW%:block%!16=7
  6300.  "Interface_SlabButton",,block%
  6301. copy_keydata(newkey%)
  6302. Index$(newkey%)=f$
  6303. ?-f$=$database%+".Indices."+Index$(newkey%)
  6304. make_empty_index(RA%,newkey%,
  6305. lit(menu%(0),2,
  6306. limit_actions(
  6307. abort_index(f$):
  6308. E*dbasehandle%=
  6309. ($database%+".Database")
  6310. indexing%=
  6311. update_stats
  6312.  file%=0 
  6313.   top=file%*8+LH%
  6314.   P%=
  6315. neighbour(key%,top,1)
  6316.   val$=
  6317. type(newkey%)
  6318.  "Hourglass_On"
  6319. scan_file("P%<>top",key%,4)
  6320.  file%
  6321. end_index
  6322. colour(newkey%,2)
  6323. warn%=
  6324. selected(passW%,16) 
  6325. #loghandle%,"Index "+Index$(newkey%)+" created"
  6326. abort_index(f$)
  6327. end_index
  6328.  replace% 
  6329. open_index(f$,newkey%)
  6330.  index%=newkey% 
  6331.  Keys%
  6332. \)    Index$(newkey%)=Index$(newkey%+1)
  6333.  index%
  6334. scrap_sliding_block(keyanchor%(newkey%))
  6335.   Keys%-=1
  6336.   newkey%=0
  6337. softerror("",43)
  6338. wimp_error(
  6339. end_index
  6340.  "Hourglass_Smash"
  6341. indexing%=
  6342. limit_actions(Access%)
  6343.  "Wimp_CreateMenu",,-1
  6344. lit(menu%(0),2,Modify%)
  6345. close_file(dbasehandle%)
  6346. shift(t%,k%,m%)
  6347.  a%,key%,fi%,I%,F$
  6348.  Access% 
  6349. =addr
  6350.  REC%=RA% 
  6351. =addr
  6352.  t%=0 
  6353.  m%=1 
  6354. confirm(
  6355. msg(51))=
  6356. =addr
  6357.  key%=0 
  6358.  Keys%
  6359. w2  N$=
  6360. key(key%):kl%=KL%(key%):val$=
  6361. type(key%)
  6362. delete(N$,key%)
  6363.  N$="*Failed*" 
  6364. =addr
  6365.  key%=k% 
  6366.  a%=SU%
  6367.  t%=1 
  6368.  fi%=(file%+1) 
  6369.  t%=-1 
  6370.  fi%=(file%-1-6*(file%=0))
  6371.   top=8*fi%+LH%
  6372.  I%=1 
  6373.  fields%
  6374.       V%=chartype%(I%)
  6375.       
  6376.         
  6377.  36,39:
  6378. R        
  6379. blob_path(
  6380. ,$database%,REC%,I%,V%,F$)>=0 
  6381.  "OS_CLI","Delete "+F$
  6382.         
  6383.  9,37:
  6384. R        
  6385. blob_path(
  6386. ,$database%,REC%,I%,V%,F$)>=0 
  6387.  "OS_CLI","Delete "+F$
  6388.         
  6389. R        
  6390. blob_path(
  6391. ,$database%,REC%,I%,V%,F$)>=0 
  6392.  "OS_CLI","Delete "+F$
  6393.       
  6394. 8    
  6395. insert(
  6396. ,N$,key%):date%?fi%=1:$Date%(fi%)=
  6397.   top=8*file%+LH%
  6398.   date%?file%=1
  6399.   $Date%(file%)=
  6400.  key%
  6401. selected(passW%,16) 
  6402.  t%=0 
  6403. )    
  6404. #loghandle%,logentry$+" Deleted"
  6405. 8    
  6406. #loghandle%,logentry$+" ===> subfile "+
  6407. (fi%)
  6408. warn%=
  6409. type(key%)
  6410.  F%,V$
  6411.  key%>=0 
  6412.  F%=KF%(key%,0) 
  6413.  F%=-key%
  6414.  chartype%(F%) 
  6415.  3,6,46,47,54,56,57:V$="VAL"
  6416. confirm(string$)
  6417. !block%=255
  6418. $(block%+4)=string$
  6419.  "Wimp_ReportError",block%,(1<<0)+(1<<1)+(1<<4),"Powerbase: please confirm:" 
  6420.  ,result%
  6421. =result%=1
  6422. getscreensize(
  6423.  S_Width%,
  6424.  S_Height%)
  6425.  H1%,V1%,H2%,V2%,End%
  6426. $H1%=0:V1%=4:H2%=8:V2%=12:End%=16
  6427. 9Mi%!H1%=4:Mi%!V1%=5:Mi%!H2%=11:Mi%!V2%=12:Mi%!End%=-1
  6428.  "OS_ReadVduVariables",Mi%,Mo%
  6429. )S_Width%=(1<<(Mo%!H1%))*((Mo%!H2%)+1)
  6430. *S_Height%=(1<<(Mo%!V1%))*((Mo%!V2%)+1)
  6431. match
  6432. check_change
  6433.  common% 
  6434. text(matchW%,0)=""
  6435. redraw_icon(matchW%,0)
  6436. open_window(matchW%)
  6437. set_caret(matchW%,0)
  6438. text(matchW%,3)=Tag$(Match_tag%)
  6439. tick_one(fieldmenu%,0,fields%-1,Match_tag%-1)
  6440. redraw_icon(matchW%,3)
  6441. text(matchW%,14)=""
  6442. redraw_icon(matchW%,14)
  6443. selected(matchW%,27) 
  6444. text(matchW%,25)="Number found" 
  6445. text(matchW%,25)="Time taken"
  6446. redraw_icon(matchW%,25)
  6447. "fieldfunc$="match":matching%=
  6448.  List printing -----------------------------------------------------
  6449. print_this
  6450. %f$=$database%+".PrintRes.Default"
  6451.  "OS_File",5,f$ 
  6452.  d%=1 
  6453. drag_selection(f$)
  6454. !old%=
  6455. selected_esg(printW%,3)
  6456. deselect(printW%,old%)
  6457. select(printW%,24)
  6458. mouse(0,0,4,matchW%,24)
  6459. clear_selection
  6460. deselect(printW%,24)
  6461. select(printW%,old%)
  6462. do_it(Search$,displayed%)
  6463.  printing% 
  6464.  zero%,P%,rec%
  6465. Form$=printorder$
  6466.  Form$="" 
  6467.  W%=0 
  6468.  KF%(0,W%)>0 
  6469. :      F$=
  6470. ~(KF%(0,W%)):
  6471. (F$)=1 
  6472.  F$="0"+F$:Form$+=F$
  6473. }      
  6474. selected(matchW%,27) 
  6475. select(mainW%,field%(KF%(0,W%))):printorder$+=F$:
  6476. lit(menu%(6),7,
  6477. lit(menu%(6),8,
  6478.         
  6479. #Heading$="":Hlongest%=0:Sum()=0
  6480. +Count%=0:examined%=0:printed%=0:sums%=0
  6481. read_print_options
  6482. selected(printW%,40) 
  6483. find_max_lengths(displayed%) 
  6484.  maxlen%()=len%()
  6485. LenLine%=
  6486. include_fields
  6487. ,numfirst%=
  6488. margin_warn:
  6489.  numfirst%<0 
  6490. list_head(0)
  6491.  "Wimp_GetPointerInfo",,block%
  6492. limit_actions(
  6493. lit(menu%(0),2,0)
  6494. printing%=
  6495.  "OS_ReadMonotonicTime" 
  6496.  stime%
  6497. abort_printing:
  6498. *dbasehandle%=
  6499. ($database%+".Database")
  6500.  "Hourglass_On"
  6501.  displayed%:
  6502. readsmarray(dbasehandle%,REC%)
  6503. print_record(REC%)
  6504.  usekey%=-1 
  6505. selected(matchW%,23)=
  6506. <  P%=
  6507. neighbour(key%,top,1):
  6508. scan_file("P%<>top",key%,1)
  6509. #  P%=
  6510. search(useval$,usekey%,1)
  6511.  P%>=0 
  6512.  k$=useval$:
  6513. scan_file("P%<>top AND k$=useval$",usekey%,1)
  6514. end_printing
  6515. abort_printing
  6516. end_printing
  6517. softerror("",29)
  6518. wimp_error(
  6519. end_printing
  6520.  time%
  6521.  format$="label" 
  6522.  thislab%>0 
  6523. print_labels
  6524.  "OS_ReadMonotonicTime" 
  6525.  etime%
  6526. time%=etime%-stime%
  6527. selected(matchW%,27) 
  6528. text(matchW%,14)=
  6529. (printed%) 
  6530. text(matchW%,14)=
  6531. (time% 
  6532.  100)+"."+
  6533. (time% 
  6534.  100)+" sec"
  6535. redraw_icon(matchW%,14)
  6536.  "Hourglass_Smash"
  6537.  format$<>"label" 
  6538.  displayed%=
  6539. total_list
  6540.  reportdest$ 
  6541.  "Window":
  6542.  scripton%) 
  6543. selected(matchW%,27)) 
  6544. screen_list
  6545. extend_named_sliding_block(textanchor%,Count%*LenLine%)
  6546.  "File":
  6547. close_file(texthandle%):
  6548.  "OS_File",18,f$,&fff
  6549. close_window(saveW%)
  6550.  "Printer":
  6551. extend_named_sliding_block(textanchor%,Count%*LenLine%+1)
  6552. B  Start%=!textanchor%:End%=Start%+Count%*LenLine%+1:Type%=&fff
  6553. )  $Start%=pitch$:?(End%-1)=0:?End%=12
  6554. ;  block%!0=256:block%!12=0:block%!16=&80142:block%!20=0
  6555. D  block%!24=0:block%!28=0:block%!32=0:block%!36=0:block%!40=&fff
  6556.   $(block%+44)="List"
  6557.  "Wimp_SendMessage",18,block%,0
  6558. )printing%=
  6559. :scripton%=
  6560. :savetofile%=
  6561. lit(menu%(0),2,Modify%)
  6562. limit_actions(Access%)
  6563. close_file(dbasehandle%)
  6564. find_max_lengths(displayed%)
  6565.  P%,k$
  6566. end_find_max:
  6567. maxlen%()=0
  6568. '*dbasehandle%=
  6569. ($database%+".Database")
  6570.  "Hourglass_On"
  6571.  "Hourglass_LEDs",%11
  6572.  displayed% 
  6573. readsmarray(dbasehandle%,REC%)
  6574. get_lengths
  6575.  usekey%=-1 
  6576. selected(matchW%,23)=
  6577. /!    P%=
  6578. neighbour(key%,top,1)
  6579. 0$    
  6580. scan_file("P%<>top",key%,0)
  6581. 1        
  6582. 2%    P%=
  6583. search(useval$,usekey%,1)
  6584.  P%>=0 
  6585.       k$=useval$
  6586. 58      
  6587. scan_file("P%<>top AND k$=useval$",usekey%,0)
  6588. 6        
  6589.  "Hourglass_LEDs",%00
  6590.  "Hourglass_Off"
  6591. close_file(dbasehandle%)
  6592. get_lengths
  6593.  I%,L%,F%,l%,F$
  6594. I%=-1:L%=
  6595. (Form$)-1
  6596.  I%<L%
  6597. B5  I%+=2:F%=
  6598. fnum(
  6599. Form$,I%,2)):F$=F$(F%):l%=
  6600.  l%>maxlen%(F%) 
  6601.  maxlen%(F%)=l%
  6602. end_find_max
  6603.  "Hourglass_Smash"
  6604. close_file(dbasehandle%)
  6605. maxlen%()=len%()
  6606. softerror("",70)
  6607. wimp_error(
  6608. print_record(REC%)
  6609.  I%,F%,N%,F$,SF$,Tab%,n$,y$,base%,pos%
  6610.  format$<>"label" 
  6611.  printed%+=1
  6612. selected(matchW%,27) 
  6613. U-thisrow%=-1:base%=!lineanchor%:pos%=base%
  6614. heap_store(lineanchor%,LenLine%,0,pos%,0,margin$)
  6615.  I%=1 
  6616. (Form$)-1 
  6617.   F%=
  6618. fnum(
  6619. Form$,I%,2))
  6620.  format$="label" 
  6621.  newline%=
  6622.  newline%
  6623.   N%+=1
  6624. selected(printW%,11) 
  6625. \-    F$=
  6626. expand(F$(F%),link$(F%),Len%,SF$)
  6627. ]        
  6628. ^!    F$=F$(F%):Len%=len%(F%)+2
  6629.  chartype%(F%) 
  6630.       
  6631.  41,42,43,44,45:
  6632.       Z%=
  6633. no_yes(F%,n$,y$)
  6634. b"      
  6635.  F$=" " 
  6636.  F$=y$ 
  6637.  F$=n$
  6638. c!      
  6639.  3,6,8,46,47,54,56,57:
  6640. d-      
  6641. sums(F$,calcrow%?F%,chartype%(F%))
  6642.       
  6643.  format$="vert" 
  6644. f&        F$=
  6645. len%(F%)-
  6646. (F$)," ")+F$
  6647. g%        
  6648. justify(F$,N%,N%-1)
  6649.       
  6650. i        
  6651. selected(printW%,12) 
  6652. u(F$)
  6653.  chartype%(F%) 
  6654.  37:F$="<Sprite>"
  6655.  38:F$="<Drawfile>"
  6656.  format$ 
  6657.  "horiz","table":
  6658. r>    
  6659. heap_store(lineanchor%,LenLine%,0,pos%,0,
  6660. tab(F$,N%))
  6661.  "vert":
  6662. tR    
  6663. selected(printW%,2) 
  6664.  Head$=$
  6665. text(mainW%,(desc%(F%))) 
  6666.  Head$=Tag$(F%)
  6667. u8    Head$=margin$+
  6668. Tab%(1)-
  6669. (Head$)," ")+Head$+" : "
  6670. v$    pos%=base%:L%=
  6671. (Head$)+
  6672. w8    
  6673. heap_store(lineanchor%,LenLine%,0,pos%,0,Head$)
  6674. x5    
  6675. heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
  6676. y*    
  6677. list_line(REC%,lineanchor%,L%,32)
  6678. zD    
  6679.  chartype%(F%)=36 
  6680.  chartype%(F%)=39 
  6681. print_memo(REC%,F%)
  6682. {#    
  6683. extra_lines(linefeed%-1,0)
  6684.  "label":
  6685.  newline% 
  6686. ~n      
  6687.  (F$<>"" 
  6688. selected(labelW%,16)=
  6689.  thisrow%<=labrepl% 
  6690.  thisrow%+=1:Label$(thisrow%,thislab%)=F$
  6691.       
  6692. /      Label$(thisrow%,thislab%)+=spacer$+F$
  6693.         
  6694.  format$ 
  6695.  "horiz":
  6696. list_line(REC%,lineanchor%,pos%-base%,32)
  6697. extra_lines(linefeed%-1,0)
  6698.  "vert":
  6699. rule_off(45)
  6700.  "table":
  6701.   colpos%=pos%-base%
  6702. heap_store(lineanchor%,LenLine%,0,pos%,0,column$)
  6703. list_line(REC%,lineanchor%,pos%-base%,32)
  6704. extra_lines(linefeed%-1,colpos%)
  6705.  "label":
  6706. ,  Label$(labrepl%+1,thislab%)=
  6707. key2(0,1)
  6708. 3  thislab%+=1:
  6709.  thislab%>labup% 
  6710. print_labels
  6711.  format$<>"label" 
  6712.  (printed% 
  6713.  LinesPerPage%)=0 
  6714. selected(printW%,10)=
  6715.  displayed%=
  6716. N    $(!lineanchor%)=margin$+
  6717. (12):
  6718. list_line(-1,lineanchor%,Lmargin%+1,32)
  6719. list_head(1)
  6720. extra_lines(ex%,tab%)
  6721.  base%,pos%
  6722.  ex%>0
  6723.  tab% 
  6724. rule_off(32)
  6725. %    base%=!lineanchor%:pos%=base%
  6726.  I%=0 
  6727.  tab%-1
  6728.       pos%?I%=32
  6729.     pos%+=tab%
  6730. :    
  6731. heap_store(lineanchor%,LenLine%,0,pos%,0,column$)
  6732. 2    
  6733. list_line(REC%,lineanchor%,pos%-base%,32)
  6734.   ex%-=1
  6735. print_memo(R%,F%)
  6736.  text%,B%,F$,sp%,L%,rem$,base%,pos%,Line$
  6737. blob_path(
  6738. ,$database%,R%,F%,36,F$)>=0 
  6739.   text%=
  6740. #text%
  6741. &    Line$=margin$+rem$:L%=
  6742. (Line$)
  6743.         
  6744.       B%=
  6745. #text%
  6746.       Line$+=
  6747. (B%):L%+=1
  6748.       
  6749.  B%=32 
  6750.  sp%=L%
  6751. )    
  6752.  B%=10 
  6753.  L%=LenLine%-3 
  6754. #text%
  6755. '      
  6756.  B%=10:rem$="":Line$=
  6757. Line$)
  6758.       
  6759. #text%:rem$=""
  6760. 2      
  6761. :rem$=
  6762. Line$,sp%+1):Line$=
  6763. Line$,sp%-1)
  6764.         
  6765.     pos%=!lineanchor%
  6766. 8    
  6767. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  6768. 0    
  6769. list_line(REC%,lineanchor%,
  6770. (Line$),32)
  6771. close_file(text%)
  6772. print_labels
  6773.  I%,Line$,S$,linesprinted%,pos%
  6774.  I%=0 
  6775.  labrepl%-1
  6776.   Line$=margin$
  6777.  K%=0 
  6778.  thislab%-1
  6779.     S$=Label$(I%,K%)
  6780. !    
  6781. selected(labelW%,11) 
  6782. 9      
  6783.  I%=labsubst% 
  6784.  S$="" 
  6785.  S$=Label$(labrepl%,K%)
  6786.         
  6787. 9    
  6788.  K%=thislab%-1 
  6789.  W%=longestfield% 
  6790.  W%=labwidth%
  6791. (S$)>W% 
  6792. S$,W%)
  6793.      Line$+=S$+
  6794. (S$)," ")
  6795.   pos%=!lineanchor%
  6796. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  6797. list_line(REC%,lineanchor%,
  6798. (Line$),32)
  6799.   linesprinted%+=1
  6800. selected(labelW%,13) 
  6801. rule_off(32)
  6802.   Line$=""
  6803.  K%=0 
  6804.  thislab%-1
  6805. (    S$="("+Label$(labrepl%+1,K%)+")"
  6806. '    Line$+=S$+
  6807. labwidth%-
  6808. (S$)," ")
  6809.   pos%=!lineanchor%
  6810. heap_store(lineanchor%,LenLine%,0,pos%,0,Line$)
  6811. list_line(REC%,lineanchor%,
  6812. (Line$),32)
  6813.   linesprinted%+=1
  6814. rows_printed%+=1
  6815.  rows_printed%=labrows% 
  6816. L  $(!lineanchor%)=margin$+
  6817. (12):
  6818. list_line(-1,lineanchor%,Lmargin%+1,32)
  6819. list_head(1)
  6820.   rows_printed%=0
  6821. rule_off(32)
  6822.     linesprinted%+=1
  6823.  linesprinted%=labdepth%
  6824. &thislab%=0:thisrow%=-1:Label$()=""
  6825. read_print_options
  6826. thislab%=0:LinesPerPage%=0
  6827.  usekey%=-1 
  6828.  S$=Index$(key%) 
  6829.  S$=Index$(usekey%)+" index"
  6830. Title1$="Ordered by "+S$
  6831. selected(printW%,19) 
  6832.  Title1$+=" ("+
  6833. $+")"
  6834. Title2$=$
  6835. text(printW%,18)
  6836. lit(menu%(18),1,
  6837. selected(printW%,10))
  6838. selected_esg(printW%,2) 
  6839.  4:cpi%=5:p$="3"
  6840.  7:cpi%=10:p$="0"
  6841.  8:cpi%=12:p$="1"
  6842.  6:cpi%=17:p$="2"
  6843. pitch$=
  6844. pitch(p$)
  6845. 3Lmargin%=
  6846. text(printW%,30)):Tab%(0)=Lmargin%
  6847. margin$=
  6848. Lmargin%," ")
  6849. "Tmargin%=
  6850. text(printW%,32))
  6851. #TextLine%=
  6852. text(printW%,34))
  6853. #linefeed%=
  6854. text(printW%,17))
  6855. #colwidth%=
  6856. text(printW%,45))
  6857. *s$=$
  6858. text(printW%,43):s%=
  6859. (s$):c$=
  6860.  s%=0:spacer$=s$
  6861.  c$<"0" 
  6862.  c$>"9":spacer$=
  6863. s%,c$)
  6864. :spacer$=
  6865. s%," ")
  6866.  linefeed%=0 
  6867.  linefeed%=1:$
  6868. text(printW%,17)=
  6869. (linefeed%)
  6870. %pagelength%=
  6871. text(printW%,16))
  6872.  pagelength%=0 
  6873.  pagelength%=70:$
  6874. text(printW%,16)=
  6875. (pagelength%)
  6876. selected_esg(printW%,3) 
  6877.   format$="horiz"
  6878. 9  LinesPerPage%=(pagelength%-Tmargin%-15) 
  6879.  linefeed%
  6880.  24:format$="vert"
  6881. J  LinesPerPage%=(pagelength%-Tmargin%-15) 
  6882.  (linefeed%*(
  6883. (Form$) 
  6884.   format$="table"
  6885. $  columns%=
  6886. text(printW%,15))
  6887. 0  column$=
  6888. columns%,"|"+
  6889. colwidth%," "))+"|"
  6890. 9  LinesPerPage%=(pagelength%-Tmargin%-15) 
  6891.  linefeed%
  6892.   format$="label"
  6893. )  labwidth%=
  6894. text(labelW%,4))*cpi%
  6895. &  labdepth%=
  6896. text(labelW%,6))*6
  6897. 1  labrows%=(pagelength%-Tmargin%) 
  6898.  labdepth%
  6899.   rows_printed%=0
  6900.  %  labup%=
  6901. selected_esg(labelW%,1)
  6902. !$  labrepl%=
  6903. text(labelW%,10))
  6904. "'  labsubst%=
  6905. text(labelW%,12))-1
  6906. #%  Title$="":Title1$="":Title2$=""
  6907. selected_esg(printW%,4) 
  6908.  38:reportdest$="Window"
  6909.  39:reportdest$="File"
  6910.  41:reportdest$="Printer"
  6911.  LinesPerPage%=0 
  6912.  LinesPerPage%=1
  6913. pitch(p$)
  6914. selected(printW%,42) 
  6915. (31)+"9"+p$+"01" 
  6916. list_head(place%)
  6917.  place%=0 
  6918.  reportdest$ 
  6919.  "Window","Printer":
  6920.     RU%=
  6921. ($used%)
  6922. 5O    
  6923.  RU%<5 
  6924.  textblocksize%=5*LenLine% 
  6925.  textblocksize%=(RU% 
  6926.  5)*LenLine%
  6927. 6$    textblockinc%=textblocksize%
  6928. 7?    
  6929. extend_named_sliding_block(textanchor%,textblocksize%)
  6930.     TextPtr%=!textanchor%
  6931.     recblocksize%=400
  6932. :=    
  6933. extend_named_sliding_block(recanchor%,recblocksize%)
  6934. ;&    
  6935.  "File"::
  6936. #texthandle%,pitch$
  6937. extra_lines(Tmargin%,0)
  6938.  displayed% 
  6939. send_title(Title$)
  6940. send_title(Title1$)
  6941. send_title(Title2$)
  6942.  format$ 
  6943.  "horiz":
  6944. selected(printW%,29) 
  6945. HV    
  6946. selected(printW%,42) 
  6947.  $(!lineanchor%)=uon$:
  6948. list_line(-1,lineanchor%,2,32)
  6949. I.    
  6950. list_line(-1,headanchor%,LenLine%,32)
  6951. rule_off(45)
  6952. L.    
  6953. list_line(-1,headanchor%,LenLine%,32)
  6954. rule_off(45)
  6955.  "table":
  6956. rule_off(32):$(TextPtr%-3)=uon$
  6957. rule_off(32)
  6958. list_line(-1,headanchor%,LenLine%,32)
  6959. rule_off(32)
  6960.  "vert":
  6961. rule_off(45)
  6962. header_lines%=Count%
  6963. list_line(REC%,anchor%,length%,char%)
  6964. Count%+=1
  6965.  reportdest$ 
  6966.  "Window","Printer":
  6967. pad_line(LenLine%-length%-1,char%)
  6968. heap_store(textanchor%,textblocksize%,textblockinc%,TextPtr%,LenLine%,"")
  6969.  "Wimp_TransferBlock",mytask%,!anchor%,mytask%,TextPtr%,LenLine%
  6970.  Count%*4>=recblocksize% 
  6971.     recblocksize%+=400
  6972. b=    
  6973. extend_named_sliding_block(recanchor%,recblocksize%)
  6974. d"  !(!recanchor%+Count%*4)=REC%
  6975.   TextPtr%+=LenLine%
  6976.  "File":
  6977. pad_line(LenLine%-length%-1,char%)
  6978.  "OS_GBPB",2,texthandle%,!anchor%,LenLine%
  6979. pad_line(bytes%,char%)
  6980.  base%,ptr%,I%
  6981. o/base%=!anchor%:ptr%=base%+LenLine%-bytes%-1
  6982.  bytes%>0 
  6983.  I%=0 
  6984.  bytes%-2
  6985.     ptr%?I%=char%
  6986. ptr%?(bytes%-1)=32
  6987. ptr%?bytes%=10
  6988. rule_off(char%)
  6989.  base%
  6990. base%=!lineanchor%
  6991. $base%=margin$
  6992. list_line(-1,lineanchor%,Lmargin%,char%)
  6993. total_list
  6994.  C%,L%,base%,pos%,L$
  6995. #L$=margin$+"Total "+
  6996. (printed%)
  6997. !base%=!lineanchor%:pos%=base%
  6998.  format$ 
  6999.  "horiz":
  7000. selected(printW%,29) 
  7001. rule_off(45)
  7002. ctotals(numfirst%)
  7003. (L$)>LenLine%-2 
  7004.  L$=margin$+
  7005. (printed%)
  7006. heap_store(lineanchor%,LenLine%,0,pos%,0,L$)
  7007. list_line(REC%,lineanchor%,pos%-base%,32)
  7008. selected(printW%,29) 
  7009. rule_off(45)
  7010.  "table":
  7011. rule_off(32)
  7012. extra_lines(linefeed%,colpos%)
  7013. ctotals(numfirst%)
  7014. lit(menu%(6),7,
  7015. send_title(T$)
  7016.  C$,L$,P%,L%
  7017.  T$="" 
  7018. L%=LenLine%-Lmargin%-1
  7019. (T$)>=L%
  7020.   P%=
  7021.     P%-=1:C$=
  7022. T$,P%,1)
  7023. "= ,.;:",C$)>0 
  7024.  P%<L%) 
  7025.  P%=0
  7026.  P%=0 
  7027. '    L$=margin$+
  7028. T$,L%-1):T$=
  7029. T$,L%)
  7030. )    
  7031.  L$=margin$+
  7032. T$,P%):T$=
  7033. T$,P%+1)
  7034.   $(!lineanchor%)=L$
  7035. list_line(-1,lineanchor%,
  7036. (L$),32)
  7037. $(!lineanchor%)=margin$+T$
  7038. list_line(-1,lineanchor%,Lmargin%+
  7039. (T$),32)
  7040. screen_list
  7041. !!block%=0:block%!4=-Count%*32
  7042. (block%!8=(LenLine%-1)*16:block%!12=0
  7043.  "Wimp_SetExtent",listW%,block%
  7044. !block%=listW%
  7045.  "Wimp_GetWindowState",,block%
  7046. ;x%=(block%!12+block%!4) 
  7047.  2:y%=(block%!16+block%!8) 
  7048. "block%!12=block%!4+LenLine%*16
  7049.  Count%<28 
  7050. "  block%!16=block%!8+Count%*32
  7051.   block%!16=block%!8+32*28
  7052.  "Wimp_CloseWindow",,block%
  7053. open_window(listW%)
  7054. Listed%=
  7055. show_menu(menu%(18),x%,y%)
  7056. sort_list
  7057. .ind%=!textanchor%+LenLine%*header_lines%-1
  7058.  I%=0 
  7059.  printed%-1
  7060.   ind%+=LenLine%
  7061.   block%!(I%*4)=ind%
  7062.  "OS_HeapSort",printed%,(block% 
  7063.  (1<<30) 
  7064.  (1<<31)),4,,!textanchor%+LenLine%*header_lines%,LenLine%
  7065. redraw(listW%)
  7066. lose_list
  7067. close_window(listW%)
  7068. scrap_sliding_block(textanchor%)
  7069. scrap_sliding_block(recanchor%)
  7070. Listed%=
  7071. parse(S$,case%)
  7072.  val%,I%,P%,F%,f%,t%,flag%,left%,right%,search$,field$,op$,bo$,target$,targ$,f$,t$,E$,E1$,TitFd$,TitTg$,simple%,date$,SF$
  7073. usekey%=-1:useval$=""
  7074.  S$="" 
  7075. u(S$)="ALL" 
  7076.  Title$=
  7077. leaf($database%),2)+". All records":="TRUE"
  7078. simple%=
  7079. simple(S$)
  7080. S$+=" ":Title$=""
  7081. (S$)>0
  7082.   W$=
  7083. word(S$," ")
  7084.  W$="NOT" 
  7085. S$,1)<>"(" 
  7086.  moan_err%,
  7087. msg(60)
  7088. strip_brackets
  7089. (W$)>0 
  7090. *    flag%=
  7091. :TitFd$="":TitTg$="":op$=""
  7092. 5      
  7093.  "AND","OR","NOT":E$=W$:Title$+=" "+E$+" "
  7094. +      
  7095.  "&":E$="AND":Title$+=" "+E$+" "
  7096.       
  7097.       E$=""
  7098.       
  7099. split
  7100.       
  7101. (field$)>0
  7102. $        f$=
  7103. word(field$,","))
  7104.         f%=
  7105. field(f$,
  7106.         f$="F$("+
  7107. (f%)+")"
  7108. (        
  7109.  case% 
  7110.  f$="FNu("+f$+")"
  7111. %        
  7112.  val% 
  7113.  f$="VAL("+f$+")"
  7114.         
  7115.  chartype%(f%) 
  7116. 3          
  7117.  5,51,52:f$="FNreverse_date("+f$+")"
  7118.         
  7119.         targ$=target$
  7120.         
  7121. (targ$)>0
  7122. '          t$=
  7123. word(targ$,","):u$=t$
  7124. B          
  7125.  flag% 
  7126.  TitTg$+=
  7127. expand(t$,link$(f%),L%,SF$)+","
  7128. 2          
  7129.  chartype%(f%)>40 
  7130. pos_neg(t$)
  7131.            
  7132.  chartype%(f%) 
  7133.             
  7134.  5,51,52:
  7135. K            
  7136. check_date(t$,2,date$)=
  7137. reverse_date(date$):u$=t$
  7138.           
  7139.           t$=""""+t$+""""
  7140. '          
  7141.  val% 
  7142.  t$="VAL("+t$+")"
  7143.           
  7144.  f%=0 
  7145.             
  7146.  op$ 
  7147. ;              
  7148.  "{","=":E1$="FNany("+t$+","""+op$+""")"
  7149. .              
  7150.  "}{":
  7151.  moan_err%,
  7152. msg(100)
  7153. .              
  7154.  "<>":
  7155.  moan_err%,
  7156. msg(101)
  7157. 7              
  7158.  moan_err%,""""+op$+""""+
  7159. msg(102)
  7160.             
  7161.             
  7162.             
  7163.  op$ 
  7164. 4              
  7165.  "{":E1$="INSTR("+f$+","+t$+")>0"
  7166. 5              
  7167.  "}{":E1$="INSTR("+f$+","+t$+")=0"
  7168.               
  7169.  "=":
  7170.               E1$=f$+op$+t$
  7171. ,              
  7172.  simple%=
  7173.  usekey%=-1 
  7174. +                foundkey%=
  7175. is_a_key(f%)
  7176. @                
  7177.  foundkey%>=0 
  7178.  KL%(foundkey%)=len%(f%) 
  7179. 2                  usekey%=foundkey%:useval$=u$
  7180.                 
  7181.               
  7182. !              
  7183. :E1$=f$+op$+t$
  7184.             
  7185.           
  7186.     @          
  7187. (E$)+
  7188. (E1$)>255 
  7189.  moan_err%,
  7190. msg(6) 
  7191.  E$+=E1$
  7192. @          
  7193. (E$)+
  7194. (bo$)>255 
  7195.  moan_err%,
  7196. msg(6) 
  7197.  E$+=bo$
  7198.         
  7199.         flag%=
  7200.       
  7201.       E$=
  7202. (E$)-
  7203. (bo$))
  7204.       
  7205. E$,bo$)>0 
  7206. =        
  7207. (E$)>253 
  7208.  moan_err%,
  7209. msg(6) 
  7210.  E$="("+E$+")"
  7211.       
  7212.         
  7213. add_brackets
  7214.   E$+=" "
  7215. (search$)+
  7216. (E$)>255 
  7217.  moan_err%,
  7218. msg(6)
  7219.  search$+=E$
  7220. build_title
  7221. ,Title$=
  7222. leaf($database%),2)+". "+Title$
  7223.  usekey%>=0 
  7224. *  kl%=KL%(usekey%):val$=
  7225. type(usekey%)
  7226. deselect(matchW%,23)
  7227. =search$
  7228. pos_neg(s$)
  7229.  "+","y","Y","*","
  7230. ","T","t":s$=" "
  7231.  "-","n","N","x","X","F","f":s$=""
  7232. simple(S$)
  7233. S$,"=")>0 
  7234. S$,",")=0 
  7235. S$,"-")=0 
  7236. S$,"OR")=0 
  7237. S$,"NOT")=0) 
  7238. word(
  7239.  S$,sep$)
  7240.  P%,W$,Q1%,Q2%
  7241. 0'  Q1%=
  7242. S$,""""):Q2%=
  7243. S$,"""",Q1%+1)
  7244.   P%=
  7245. S$,sep$,P%)
  7246. 3-    
  7247.  (P%>Q1% 
  7248.  P%<Q2%),(P%>Q2% 
  7249.  Q2%>0):
  7250. 45    S$=
  7251. S$,Q1%-1)+
  7252. S$,Q1%+1,Q2%-Q1%-1)+
  7253. S$,Q2%+1)
  7254. 59    P%=Q2%-2:
  7255.  ### S$ is now 2 characters shorter ###
  7256. 6)    
  7257.  Q1%>0 
  7258.  Q2%=0:
  7259. softerror("",93)
  7260. 7     S$=
  7261. S$,Q1%-1)+
  7262. S$,Q1%+1)
  7263.  Q1%+Q2%=0 
  7264.  P%<Q1%
  7265. S$,P%-1)
  7266. S$,P%+1)
  7267. any(targ$,op$)
  7268.  F%,found%,case%,F$
  7269. case%=
  7270. selected(matchW%,16)
  7271.   F%+=1:F$=F$(F%)
  7272.  case% 
  7273. u(F$)
  7274.  op$ 
  7275. E'    
  7276.  "{":
  7277. F$,targ$)>0 
  7278.  found%=
  7279. F#    
  7280.  "=":
  7281.  F$=targ$ 
  7282.  found%=
  7283.  found% 
  7284.  F%=fields%
  7285. =found%
  7286. split
  7287.  X$,Q%,I%
  7288. M8X$=">=>=,<=<=,<>,}{,>=,<=,==,>>,<<,{{,=,<,>,{,":P%=0
  7289. (X$)>0 
  7290.  P%=0
  7291. O,  Q%=
  7292. X$,","):op$=
  7293. X$,Q%-1):X$=
  7294. X$,Q%+1)
  7295.   P%=
  7296. W$,op$)
  7297.  P%>0 
  7298.   field$=
  7299. W$,P%-1)
  7300. T   target$=
  7301. W$,P%+
  7302. (op$))+","
  7303.  case% 
  7304.  target$=
  7305. u(target$)
  7306.   field$=
  7307. exp_field
  7308.  op$ 
  7309.  "<>","}{":bo$="AND"
  7310.  "<=",">=":bo$="OR"
  7311.  "<=<=",">=>=":
  7312.     op$=
  7313. op$,2):bo$="AND"
  7314.  "==","<<",">>","{{":
  7315.     op$=
  7316. op$,1):bo$="AND"
  7317. :bo$="OR"
  7318.  moan_err%,
  7319. msg(40)
  7320. exp_field
  7321.  P%,I%,F1%,F2%,F$
  7322. field$,"-")
  7323.  P%=0 
  7324.   F$=field$+","
  7325. j!  F1%=
  7326. field(
  7327. field$,P%-1),
  7328. k!  F2%=
  7329. field(
  7330. field$,P%+1),
  7331.  F1%>F2% 
  7332.  F1%,F2%
  7333.  I%=F1% 
  7334.     F$+=Tag$(I%)+","
  7335. fnum(S$)
  7336. ("&"+S$)
  7337. newline%=((N% 
  7338.  128)>0)
  7339. =(N% 
  7340.  127)
  7341. field(f$,Z%)
  7342.  I%,F%,desc$
  7343.  f$="@" 
  7344.  TitFd$="Any field ":=0
  7345. val%=
  7346. f$,1)="[" 
  7347. f$)="]" 
  7348. f$),2):val%=
  7349.  I%<fields%
  7350.   I%+=1
  7351. u(Tag$(I%))=
  7352. u(f$) 
  7353.  F%=I%
  7354.  F%>0 
  7355. $  desc$=$
  7356. text(mainW%,desc%(F%))
  7357.  desc$<>"" 
  7358.  TitFd$+=desc$+"," 
  7359.  TitFd$+=f$+","
  7360.  F%=0 
  7361.  moan_err%,
  7362. msg(8)+" ("+f$+")"+
  7363.  chartype%(F%) 
  7364.  3,6,46,47,54,56,57:val%=
  7365. find_fields(S$,sep$,
  7366.  length%)
  7367.  f$,F$,C$,P%,Q%,F%
  7368. Q%=1:length%=0
  7369.   P%=
  7370. S$,sep$,Q%)
  7371.  P%>0 
  7372. S$,Q%,P%-Q%)
  7373.   F%=
  7374. field(f$,
  7375.   length%+=len%(F%)+1
  7376.   F$=
  7377. ~(F%)
  7378. (F$)=1 
  7379.  F$="0"+F$
  7380.   C$+=F$
  7381.   Q%=P%+1
  7382. length%+=
  7383. (RA%))+1
  7384. strip_brackets
  7385. W$,1)="("
  7386.   left%+=1:W$=
  7387. W$,2)
  7388. W$)=")"
  7389.   right%+=1:W$=
  7390. add_brackets
  7391.  left%>0
  7392.   E$="("+E$:left%-=1
  7393.  right%>0
  7394.   E$+=")":right%-=1
  7395. build_title
  7396.  change%
  7397. #TitFd$=
  7398. TitFd$):TitTg$=
  7399. TitTg$)
  7400. TitFd$,",")>0 
  7401.  bo$ 
  7402. &    
  7403.  "OR":TitFd$="One of:"+TitFd$
  7404.  "AND":
  7405.  op$ 
  7406. ;      
  7407.  "<>":TitFd$="None of:"+TitFd$:op$="=":change%=
  7408. ;      
  7409.  "}{":TitFd$="None of:"+TitFd$:op$="{":change%=
  7410. #      
  7411. :TitFd$="All of:"+TitFd$
  7412.         
  7413. TitTg$,",")>0 
  7414.  bo$ 
  7415. &    
  7416.  "OR":TitTg$="One of:"+TitTg$
  7417.  "AND":
  7418.  op$ 
  7419. 1      
  7420.  "<>":TitTg$="None of:"+TitTg$:op$="="
  7421. 1      
  7422.  "}{":TitTg$="None of:"+TitTg$:op$="{"
  7423. I      
  7424.  change% 
  7425.  TitTg$="Any of:"+TitTg$ 
  7426.  TitTg$="All of:"+TitTg$
  7427.         
  7428.  op$ 
  7429.  "{":op$=" contains "
  7430.  "}{":op$=" does not contain "
  7431. Title$+=TitFd$+op$+TitTg$
  7432. expand(string$,table$,
  7433.  ExpLen%,
  7434.  subst$)
  7435.  p$,s$,start%,F%,I%,T%,ind%,row%,Rec%,Rows%,TabFields%,field%,sfield%,pos%,spos%
  7436. subst$=string$
  7437.  table$="" 
  7438.  ExpLen%=0:=string$:
  7439.  ### Not linked ###
  7440. &field%=
  7441. table$)):table$=
  7442. table$)
  7443. (table$)<58 
  7444. (table$)<>-1 
  7445.  sfield%=
  7446. (table$):table$=
  7447. table$,2) 
  7448.  sfield%=-1
  7449. table_number(table$)
  7450.  T%<0 
  7451.  ExpLen%=0:=string$:
  7452.  ### Table not found ###
  7453. p$=printrel$(T%)
  7454. table_info(T%,Rows%,TabFields%,Rec%,tabfieldlen%())
  7455. ,pos%=
  7456. table_field(field%,tabfieldlen%())
  7457.  sfield%>=0 
  7458.  spos%=
  7459. table_field(sfield%,tabfieldlen%())
  7460.  p$<>"" 
  7461.   ExpLen%=0
  7462.  I%=1 
  7463.     F%=
  7464. p$,I%,1))
  7465. #    ExpLen%+=tabfieldlen%(F%)+2
  7466.   ExpLen%-=2
  7467.  ExpLen%=tabfieldlen%(1)
  7468. 4start%=!tabanchor%(T%)+160-Rec%:ind%=start%+pos%
  7469.   row%+=1:ind%+=Rec%
  7470.  row%>Rows% 
  7471.  $ind%=string$
  7472.  row%>Rows% 
  7473.  subst$="":=string$:
  7474.  ## String not in table ###
  7475. =ind%=start%+row%*Rec%:
  7476.  sfield%>=0 
  7477.  subst$=$(ind%+spos%)
  7478.  p$<>"" 
  7479.  I%=1 
  7480.     F%=
  7481. p$,I%,1))
  7482. ,    pos%=
  7483. table_field(F%,tabfieldlen%())
  7484. 4    s$+=
  7485. pad($(ind%+pos%),tabfieldlen%(F%))+"  "
  7486.   s$=
  7487.  ind%+=tabfieldlen%(0)+1:s$=$ind%:
  7488.  ### Return 2nd field ###
  7489. n(F%)
  7490.  T%,row%,ind%,start%,Rows%,Rec%,TabFields%,pos%,valpos%,N%,field%,name$,table$,S$
  7491.  link$(F%)="" 
  7492. S$=$Rf%(F%)
  7493. name$=link$(F%)
  7494. $field%=
  7495. name$)):table$=
  7496. name$)
  7497. (table$)<58 
  7498. (table$)<>-1 
  7499.  table$=
  7500. table$,2)
  7501. /table%=
  7502. table_number(table$):
  7503.  table%<0 
  7504. table_info(table%,Rows%,TabFields%,Rec%,tabfieldlen%())
  7505.  TabFields%=field% 
  7506. softerror("",54):=0
  7507. ,pos%=
  7508. table_field(field%,tabfieldlen%())
  7509. 1valpos%=
  7510. table_field(field%+1,tabfieldlen%())
  7511. 'start%=!tabanchor%(table%)+160-Rec%
  7512.  row%+=1
  7513.    ind%=start%+row%*Rec%+pos%
  7514.  row%>Rows% 
  7515.  S$=$ind%
  7516.  row%<=Rows% 
  7517. #  ind%=start%+row%*Rec%+valpos%
  7518.   N%=
  7519. ($ind%)
  7520.  N%=0
  7521. pad(s$,L%)
  7522. (s$)<L%
  7523.   s$+=" "
  7524. include_fields
  7525.  Hdlen%,Datlen%,hlm%,dlm%,I%,F%,f$,Head$,limit%,pad%,col%,fail%,n$,y$,SF$,memo%,base%,pos%,blocksize%,blockinc%
  7526. 'blocksize%=256:blockinc%=blocksize%
  7527. extend_named_sliding_block(headanchor%,blocksize%)
  7528. !base%=!headanchor%:pos%=base%
  7529. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,margin$)
  7530.  I%=1 
  7531. (Form$)-1 
  7532.   F%=
  7533. fnum(
  7534. Form$,I%,2))
  7535.  chartype%(F%) 
  7536. 0    
  7537.  36,39:dlm%=TextLine%:memo%=
  7538. set_vert
  7539.  41,42,43,44,45:
  7540. !    Datlen%=
  7541. no_yes(F%,n$,y$)
  7542. E    
  7543.  ### Get data length for strings printed for check boxes ###
  7544. selected(printW%,11) 
  7545.  /    f$=
  7546. expand("@#*",link$(F%),Datlen%,SF$)
  7547. !)    
  7548.  Datlen%=0 
  7549.  Datlen%=maxlen%(F%)
  7550. "        
  7551.     Datlen%=maxlen%(F%)
  7552.  Datlen%>dlm% 
  7553.  dlm%=Datlen%
  7554. selected(printW%,2) 
  7555.  Head$=$
  7556. text(mainW%,(desc%(F%))) 
  7557.  Head$=Tag$(F%)
  7558.   Hdlen%=
  7559. (Head$)
  7560.  Hdlen%>hlm% 
  7561.  hlm%=Hdlen%
  7562.  format$ 
  7563.  "horiz","table":
  7564. +-    pad%=Datlen%-Hdlen%:
  7565.  pad%<0 
  7566.  pad%=0
  7567.  chartype%(F%) 
  7568. -c      
  7569.  3,6,46,47,54,56,57:
  7570. selected(printW%,11) 
  7571.  Head$+=
  7572. pad%," ") 
  7573.  Head$=
  7574. pad%," ")+Head$
  7575. .A      
  7576.  ### Right justify numbers unless Expand option on ###
  7577.       
  7578. :Head$+=
  7579. pad%," ")
  7580. 0        
  7581. 1J    
  7582. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,Head$+spacer$)
  7583. 2#    Tab%((I%+1) 
  7584.  2)=pos%-base%
  7585.  format$ 
  7586.  "horiz":L%=pos%-base%+2
  7587.  "vert":
  7588.  memo% 
  7589.     L%=TextLine%+5
  7590. :!    
  7591.  L%=Lmargin%+hlm%+dlm%+6
  7592.   Tab%(1)=hlm%
  7593.  "table":
  7594.   col%=
  7595. (column$)
  7596. heap_store(headanchor%,blocksize%,blockinc%,pos%,0,column$+" ")
  7597.   ?pos%=10:L%=pos%-base%+1
  7598.  "label":
  7599.   longestfield%=dlm%
  7600. C)  L%=labup%*labwidth%+dlm%+Lmargin%+1
  7601. extend_named_sliding_block(lineanchor%,L%+8)
  7602. no_yes(F%,
  7603.  no$,
  7604.  yes$)
  7605.  P%,V$,L%
  7606. val(mainW%,field%(F%))
  7607. V$,"Q")
  7608.  P%>0 
  7609.   V$=
  7610. V$,P%+1)
  7611.   P%=
  7612. V$,",")
  7613.   no$=
  7614. V$,P%-1)
  7615.   yes$=
  7616. V$,P%+1)
  7617.  no$="N":yes$="Y"
  7618. (no$)
  7619. (yes$)>L% 
  7620. (yes$)
  7621. heap_store(anchor%,
  7622.  size%,inc%,
  7623.  ptr%,L%,string$)
  7624.  string$<>"" 
  7625. (string$)
  7626.  ptr%-!anchor%+L%+1>size% 
  7627.   size%+=inc%
  7628. extend_named_sliding_block(anchor%,size%)
  7629.  string$<>"" 
  7630.  $ptr%=string$:ptr%+=L%:?ptr%=10
  7631. set_vert
  7632. deselect(printW%,23)
  7633. deselect(printW%,25)
  7634. deselect(printW%,26)
  7635. select(printW%,24)
  7636. format$="vert"
  7637. f?LinesPerPage%=(pagelength%-10) 
  7638.  (linefeed%*(
  7639. (Form$) 
  7640.  LinesPerPage%=0 
  7641.  LinesPerPage%=1
  7642. drag_selection(f$)
  7643.  F%,I%,T%,F
  7644. printorder$=
  7645. n    T%=-1
  7646.   T%+=1
  7647.   printrel$(T%)=
  7648. close_file(F)
  7649.  F%=1 
  7650.  fields%
  7651.  chartype%(F%)>40 
  7652. v.    col%=
  7653. get_icon_cols(mainW%,field%(F%))
  7654. wE    
  7655.  (col% 
  7656.  %1111)<2 
  7657.  col%=((col%>>4) 
  7658.  (col%<<4)) 
  7659.  %11111111
  7660. x.    
  7661. set_icon_cols(mainW%,field%(F%),col%)
  7662. y&    
  7663. deselect(mainW%,field%(F%))
  7664.  I%=1 
  7665. (printorder$)-1 
  7666. }"  F%=
  7667. fnum(
  7668. printorder$,I%,2))
  7669.  chartype%(F%)>40 
  7670. .    col%=
  7671. get_icon_cols(mainW%,field%(F%))
  7672. 0    col%=((col%>>4) 
  7673.  (col%<<4)) 
  7674.  %11111111
  7675. .    
  7676. set_icon_cols(mainW%,field%(F%),col%)
  7677. $    
  7678. select(mainW%,field%(F%))
  7679. lit(menu%(6),7,
  7680. lit(menu%(6),8,
  7681. select_all
  7682.  F%,T%,F$
  7683. printorder$=""
  7684.  F%=1 
  7685.  fields%
  7686.  chartype%(F%) 
  7687.  41,42,43,44,45:
  7688. .    col%=
  7689. get_icon_cols(mainW%,field%(F%))
  7690. F    
  7691.  (col% 
  7692.  %1111)>=2 
  7693.  col%=((col%>>4) 
  7694.  (col%<<4)) 
  7695.  %11111111
  7696. .    
  7697. set_icon_cols(mainW%,field%(F%),col%)
  7698. '    F$=
  7699. ~(F%):
  7700. (F$)=1 
  7701.  F$="0"+F$
  7702.     printorder$+=F$
  7703.  0,1,2,4,5,7,8:
  7704.  len%(F%)>0 
  7705. )      F$=
  7706. ~(F%):
  7707. (F$)=1 
  7708.  F$="0"+F$
  7709.       printorder$+=F$
  7710. $      
  7711. select(mainW%,field%(F%))
  7712.         
  7713. (    
  7714.  36,39,48,49,50,51,52,53,55,58:
  7715. '    F$=
  7716. ~(F%):
  7717. (F$)=1 
  7718.  F$="0"+F$
  7719.     printorder$+=F$
  7720. "    
  7721. select(mainW%,field%(F%))
  7722.  3,6,46,47,54,56,57:
  7723. '    F$=
  7724. ~(F%):
  7725. (F$)=1 
  7726.  F$="0"+F$
  7727.     printorder$+=F$
  7728. "    
  7729. select(mainW%,field%(F%))
  7730. "    
  7731. enable_row(calcrow%?F%,
  7732. lit(menu%(6),7,
  7733. lit(menu%(6),8,
  7734. clear_selection
  7735.  F%,T%
  7736.  F%=1 
  7737.  fields%
  7738.  chartype%(F%) 
  7739.  41,42,43,44,45:
  7740. .    col%=
  7741. get_icon_cols(mainW%,field%(F%))
  7742. E    
  7743.  (col% 
  7744.  %1111)<2 
  7745.  col%=((col%>>4) 
  7746.  (col%<<4)) 
  7747.  %11111111
  7748. .    
  7749. set_icon_cols(mainW%,field%(F%),col%)
  7750. V    
  7751.  3,6,8,46,47,54,56,57:
  7752. enable_row(calcrow%?F%,
  7753. deselect(mainW%,field%(F%))
  7754. &    
  7755. deselect(mainW%,field%(F%))
  7756. printorder$=""
  7757.  T%=0 
  7758.  LastTable%
  7759.   printrel$(T%)=""
  7760. lit(menu%(6),7,
  7761. lit(menu%(6),8,
  7762. drag_query(f$)
  7763.  F%,I%,Q$
  7764. selected(keypadW%,22) 
  7765.  "OS_File",255,f$,
  7766. text(keypadW%,29)
  7767. set_caret(keypadW%,29)
  7768. redraw_icon(keypadW%,29)
  7769.  "OS_File",255,f$,
  7770. text(matchW%,0)
  7771. open_window(matchW%)
  7772. set_caret(matchW%,0)
  7773. redraw_icon(matchW%,0)
  7774. drag_options(f$)
  7775.  F,I%,set%,ic%
  7776. end_load:
  7777.  I%=1 
  7778. #F,set%:
  7779. set_icon(printW%,ic%,set%)
  7780.  I%=1 
  7781. text(printW%,ic%)
  7782. redraw_icon(printW%,ic%)
  7783.  I%=1 
  7784. #F,set%:
  7785. set_icon(printW%,ic%,set%)
  7786.  I%=1 
  7787. #F,set%:
  7788. set_icon(labelW%,ic%,set%)
  7789.  I%=1 
  7790. text(labelW%,ic%)
  7791.  I%=1 
  7792. #F,set%:
  7793. set_icon(labelW%,ic%,set%)
  7794. close_file(F)
  7795. icon_bit(22,printW%,15,
  7796. selected(printW%,25))
  7797. icon_bit(22,printW%,45,
  7798. selected(printW%,25))
  7799. icon_bit(22,labelW%,12,
  7800. selected(labelW%,11))
  7801.  1,2,4,6,7,8,23,24,25,26,38,39,41:REM Radio buttons
  7802.  15,16,17,18,30,32,34,43,45:REM Writable fields
  7803.  10,11,12,19,29,40,42:REM Option switches
  7804.  In Label Definition window
  7805.  0,1,2:REM Radio buttons
  7806.  4,6,10,12:REM Writeable fields
  7807.  11,13,16:REM Option switches
  7808. end_load
  7809. close_file(F)
  7810.  222:
  7811. wimp_error(
  7812. ,fatal_err%,
  7813. ,f$+" not found")
  7814. wimp_error(
  7815. ,moan_err%,
  7816. ,f$+" is too old and is being deleted")
  7817.  "OS_CLI","Delete "+f$
  7818. leaf(f$)="PrintOpts" 
  7819. drag_options("<Pbase$Dir>.Resources.PrintOpts")
  7820. wimp_error(
  7821. ,moan_err%,
  7822. design_field
  7823.  w%,h%
  7824. posx%=x%:posy%=y%
  7825. 3!block%=mainW%:
  7826.  "Wimp_GetWindowState",,block%
  7827. x%+=block%!20-block%!4
  7828. y%+=block%!24-block%!16
  7829.  %1111111 
  7830.  (ic% 
  7831.  2)=1 
  7832.  drag%=6:dragbutt%=16 
  7833.  drag%=5:dragbutt%=64
  7834. init_drag(mainW%,ic%,drag%)
  7835.   $InsText%=""
  7836. deselect(createW%,
  7837. selected_esg(createW%,1))
  7838.  ic%>=0 
  7839. lit(menu%(9),0,
  7840. B    !block%=mainW%:block%!4=ic%:
  7841.  "Wimp_GetIconState",,block%
  7842. M    x%=block%!8:y%=block%!12:w%=block%!16-block%!8:h%=block%!20-block%!12
  7843. $    Fieldnumber%=
  7844. get_field(ic%)
  7845. %    type%=chartype%(Fieldnumber%)
  7846.  type% 
  7847.       
  7848.  0,1,2,3,4,5,6,7,8:
  7849.       
  7850. select(createW%,21)
  7851.       
  7852. set_limits(1,0,8,8)
  7853.       
  7854.  36,37,38,39,40:
  7855.       
  7856. select(createW%,22)
  7857. "      
  7858. set_limits(36,36,40,11)
  7859.       
  7860.  41,42,43,44,45:
  7861.       
  7862. select(createW%,24)
  7863. !"      
  7864. set_limits(41,41,45,14)
  7865. "6      
  7866.  46,47,48,49,50,51,52,53,54,55,56,57,58,59:
  7867.       
  7868. select(createW%,35)
  7869. $"      
  7870. set_limits(46,46,59,16)
  7871.       
  7872.       
  7873. select(createW%,23)
  7874. '       
  7875. set_limits(9,9,35,19)
  7876. (        
  7877.     fieldtype%=type%
  7878. *R    
  7879. tick_one(menu%(menunumber%),0,lasttype%-firsttype%,fieldtype%-firsttype%)
  7880. +4    $FtitleText%="Modify field "+
  7881. (Fieldnumber%)
  7882. ,5    $DescText%=$
  7883. text(mainW%,desc%(Fieldnumber%))
  7884. -$    $TagText%=Tag$(Fieldnumber%)
  7885. .'    $LenText%=
  7886. (len%(Fieldnumber%))
  7887. /$    $ValText%=vname$(fieldtype%)
  7888. 0l    
  7889.  fix%(Fieldnumber%)>0 
  7890.  $Fixpt%=
  7891. (fix%(Fieldnumber%)):
  7892. select(createW%,14) 
  7893. deselect(createW%,14)
  7894. 1:    
  7895. icon_bit(22,createW%,13,(
  7896. selected(createW%,14)))
  7897. 2?    
  7898. icon_bit(22,createW%,14,(fieldtype%=3 
  7899.  fieldtype%=6))
  7900. 3#    
  7901. icon_bit(22,createW%,18,
  7902. 4[    
  7903. icon_bit(22,createW%,6,(fieldtype%<9 
  7904.  fieldtype%=46 
  7905.  fieldtype%=47) 
  7906.  adjust%)
  7907. 5+    
  7908. icon_bit(22,createW%,30,
  7909.  adjust%)
  7910. 6#    
  7911. icon_bit(22,createW%,29,
  7912. 7@    
  7913. icon_bit(22,createW%,15,(fieldtype%=3 
  7914.  fieldtype%=47))
  7915. 80    
  7916. icon_bit(22,createW%,25,(fieldtype%=3))
  7917. 9*    C$=calc$(Fieldnumber%):P%=
  7918. C$,"|")
  7919. :8    
  7920.  P%>0 
  7921.  $mintext%=
  7922. C$,P%-1):$maxtext%=
  7923. C$,P%+1)
  7924.  I%=21 
  7925. <-      
  7926. icon_bit(22,createW%,I%,
  7927.  adjust%)
  7928. >+    
  7929. icon_bit(22,createW%,35,
  7930.  adjust%)
  7931. ?+    
  7932. icon_bit(22,createW%,39,
  7933.  adjust%)
  7934. @+    
  7935. icon_bit(22,createW%,40,
  7936.  adjust%)
  7937. A        
  7938. B"    
  7939. lit(menu%(9),0,
  7940.  adjust%)
  7941. select(createW%,21)
  7942. set_limits(1,0,8,8)
  7943. E.    $FtitleText%="New field "+
  7944. (fields%+1)
  7945. F/    $DescText%="":$TagText%="":$LenText%=""
  7946. G-    $Fixpt%="2":$mintext%="":$maxtext%=""
  7947. deselect(createW%,14)
  7948. I#    
  7949. icon_bit(22,createW%,13,
  7950. J#    
  7951. icon_bit(22,createW%,14,
  7952. K#    
  7953. icon_bit(22,createW%,15,
  7954. L#    
  7955. icon_bit(22,createW%,25,
  7956. M#    
  7957. icon_bit(22,createW%,29,
  7958. N#    
  7959. icon_bit(22,createW%,30,
  7960. O#    
  7961. icon_bit(22,createW%,39,
  7962. P#    
  7963. icon_bit(22,createW%,40,
  7964. Q+    
  7965. icon_bit(22,createW%,18,
  7966.  adjust%)
  7967. S9  $boxX%=
  7968. (x%):$boxY%=
  7969. (y%):$boxW%=
  7970. (w%):$boxH%=
  7971. close_window(createW%)
  7972. show_menu(menu%(9),posx%-64,posy%-20)
  7973. init_drag(mainW%,ic%,5):dragbutt%=64
  7974. remove_field(Field%,con%,
  7975.  Calc$)
  7976.  con% 
  7977. confirm(
  7978. msg(53))=
  7979. ])!block%=mainW%:block%!4=desc%(Field%)
  7980.  "Wimp_GetIconState",,block%
  7981. _"posx%=block%!8:posy%=block%!12
  7982.  "Wimp_DeleteIcon",,block%
  7983. a8block%!4=field%(Field%):
  7984.  "Wimp_DeleteIcon",,block%
  7985. fields%-=1
  7986. Calc$=calc$(Field%)
  7987.  F%=Field% 
  7988.  fields%
  7989.   desc%(F%)=desc%(F%+1):field%(F%)=field%(F%+1):Tag$(F%)=Tag$(F%+1):len%(F%)=len%(F%+1):chartype%(F%)=chartype%(F%+1):fix%(F%)=fix%(F%+1):calc$(F%)=calc$(F%+1)
  7990. !block%=mainW%
  7991.  "Wimp_GetWindowState",,block%
  7992. i;posx%-=block%!20-block%!4:posy%-=block%!24-block%!16-48
  7993.  "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16
  7994. create_field(Before%,x%,y%,Calc$)
  7995.  Desc%,Field%,F%,tag$,Len%,Char%,F%,L%,LF%,x%,y%,width%,height%
  7996.  fields%=MaxFields% 
  7997. softerror(
  7998. (MaxFields%),23):
  7999.  $DescText%="" 
  8000.  $TagText%="" 
  8001.  fieldtype%<=8 
  8002. q%L%=
  8003. ($DescText%):LF%=
  8004. ($LenText%)
  8005.  LF%>246 
  8006. softerror("",64):
  8007. s@x%=
  8008. ($boxX%):y%=
  8009. ($boxY%):width%=
  8010. ($boxW%):height%=
  8011. ($boxH%)
  8012.  fieldtype% 
  8013.  39,40,59:
  8014.   LF%=0
  8015.  width%=0 
  8016.  width%=48
  8017.  height%=0 
  8018.  height%=48
  8019.  41,42,43,44,45:LF%=1
  8020.  8,48,50:LF%=8
  8021.  49:LF%=15
  8022.  51:LF%=10
  8023.  52,58:LF%=24
  8024.  53,55:LF%=3
  8025.  54,56:LF%=2
  8026.  57:LF%=4
  8027.  LF%>0 
  8028.  $TagText%="" 
  8029. softerror("",16):
  8030.  F%+=1
  8031.  $TagText%=Tag$(F%) 
  8032.  F%>fields%
  8033.  F%<=fields% 
  8034.  $TagText%<>"" 
  8035. softerror("",20):
  8036. 8fields%+=1:Tag$(fields%)=$TagText%:len%(fields%)=LF%
  8037.  width%=0 
  8038.  $TagText%<>"" 
  8039.  len%(fields%)<70 
  8040.  width%=len%(fields%)*16+16 
  8041.  width%=70*16+16
  8042.  height%=0 
  8043.  width%>0 
  8044.  height%=48
  8045. !chartype%(fields%)=fieldtype%
  8046. selected(createW%,14) 
  8047.  fix%(fields%)=
  8048. ($Fixpt%) 
  8049.  fix%(fields%)=0
  8050. extend_named_sliding_block(formanchor%,Fptr%-!formanchor%+L%+6)
  8051. kdesc%(fields%)=
  8052. create_icon(mainW%,x%-L%*16-16,y%,L%*16+8,48,(winback%<<28)+&7016731,"",Fptr%,hand%,L%)
  8053. !$Fptr%=$DescText%:Fptr%+=L%+1
  8054. $Fptr%=""
  8055.  fieldtype% 
  8056.   min$=$
  8057. text(createW%,15)
  8058.   max$=$
  8059. text(createW%,25)
  8060.  min$<>"" 
  8061.  max$<>"" 
  8062.  calc$(fields%)=min$+"|"+max$:calc$(0)="LOADED"
  8063. 3  min$=$
  8064. text(createW%,15):
  8065.  min$="" 
  8066.  min$="0"
  8067. 4  calc$(fields%)=min$+"|"+min$:calc$(0)="LOADED"
  8068.  fieldtype% 
  8069.  0,1,2,3,4,5,6,7,8,39,40,46,47,48,49,50,51,52,53,54,55,56,57:valptr%=hand%
  8070. :valptr%=hvalid%(fieldtype%)
  8071. icon_design(fieldtype%,1,width%,height%)
  8072. Xfield%(fields%)=
  8073. create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
  8074.  fieldtype%=40 
  8075.  Rf%(fields%)=
  8076. create_anchor("Picture"+
  8077. (fields%))
  8078. Fptr%+=5
  8079. redraw_icon(mainW%,desc%(fields%)):
  8080. redraw_icon(mainW%,field%(fields%))
  8081.  Before%<fields% 
  8082.  Before%>0 
  8083. re_sequence(fields%,Before%,-1)
  8084. adjust_field(b%)
  8085.  Dptr%,Fptr%
  8086.  "Wimp_GetPointerInfo",,block%
  8087.  newx%=!block%:newy%=block%!4
  8088. #Fieldnumber%=
  8089. get_field(ficon%)
  8090.  (ficon% 
  8091.  2)=0 
  8092. C  !block%=mainW%:block%!4=ficon%:
  8093.  "Wimp_GetIconState",,block%
  8094. .  Dptr%=block%!28:Desc$=$Dptr%:L%=
  8095. (Desc$)
  8096.  "Wimp_DeleteIcon",,block%
  8097.  "Wimp_GetWindowState",,block%
  8098. -  x%=block%!20-block%!4+newx%-oldx%+minx%
  8099. .  y%=block%!24-block%!16+miny%+newy%-oldy%
  8100. [  desc%(Fieldnumber%)=
  8101. create_icon(mainW%,x%,y%,L%*16+8,48,&17016731,"",Dptr%,hand%,L%)
  8102. C  !block%=mainW%:block%!4=ficon%:
  8103.  "Wimp_GetIconState",,block%
  8104.   Fptr%=block%!28
  8105. $    
  8106.  "Wimp_DeleteIcon",,block%
  8107. (    
  8108.  "Wimp_GetWindowState",,block%
  8109. #    x%=block%!20-block%!4+minx%
  8110. 0    y%=block%!24-block%!16+miny%+newy%-oldy%
  8111. F    width%=maxx%-minx%+newx%-oldx%:height%=maxy%-miny%+oldy%-newy%
  8112. G    !block%=mainW%:block%!4=ficon%-1:
  8113.  "Wimp_GetIconState",,block%
  8114. 0    Dptr%=block%!28:Desc$=$Dptr%:L%=
  8115. (Desc$)
  8116. $    
  8117.  "Wimp_DeleteIcon",,block%
  8118. C    !block%=mainW%:block%!4=ficon%:
  8119.  "Wimp_DeleteIcon",,block%
  8120. (    
  8121.  "Wimp_GetWindowState",,block%
  8122. 8    x%=block%!20-block%!4+newx%-oldx%+minx%-L%*16-16
  8123. 0    y%=block%!24-block%!16+miny%+newy%-oldy%
  8124. k    desc%(Fieldnumber%)=
  8125. create_icon(mainW%,x%,y%,L%*16+8,48,(winback%<<28)+&7016731,"",Dptr%,hand%,L%)
  8126. (    
  8127.  "Wimp_GetWindowState",,block%
  8128. /    x%=block%!20-block%!4+newx%-oldx%+minx%
  8129. 0    y%=block%!24-block%!16+miny%+newy%-oldy%
  8130. .    width%=maxx%-minx%:height%=maxy%-miny%
  8131. (  fieldtype%=chartype%(Fieldnumber%)
  8132.  fieldtype% 
  8133. V    
  8134.  0,1,2,3,4,5,6,7,8,39,40,46,47,48,49,50,51,52,53,54,55,56,57,58:valptr%=hand%
  8135. !    
  8136.  59:valptr%=!logoanchor%
  8137. %    
  8138. :valptr%=hvalid%(fieldtype%)
  8139. icon_design(fieldtype%,1,width%,height%)
  8140. _  field%(Fieldnumber%)=
  8141. create_icon(mainW%,x%,y%,width%,height%,iflags%,"",Fptr%,valptr%,4)
  8142.  fieldtype%=40 
  8143.  Rf%(Fieldnumber%)=
  8144. create_anchor("Picture"+
  8145. (Fieldnumber%))
  8146. @$boxX%=
  8147. (x%):$boxY%=
  8148. (y%):$boxW%=
  8149. (width%):$boxH%=
  8150. (height%)
  8151. !block%=mainW%
  8152.  "Wimp_GetWindowState",,block%
  8153.  "Wimp_ForceRedraw",-1,block%!4,block%!8,block%!12,block%!16
  8154. swap_fields(F1%,F2%)
  8155.  F2%>0 
  8156.  F2%<=fields% 
  8157.  desc%(F1%),desc%(F2%)
  8158.  Tag$(F1%),Tag$(F2%)
  8159.  field%(F1%),field%(F2%)
  8160.  len%(F1%),len%(F2%)
  8161.  chartype%(F1%),chartype%(F2%)
  8162.  fix%(F1%),fix%(F2%)
  8163.  calc$(F1%),calc$(F2%)
  8164. close_window(createW%)
  8165. re_sequence(F1%,F2%,Z%)
  8166. wD%=desc%(F1%):T$=Tag$(F1%):F%=field%(F1%):L%=len%(F1%):C%=chartype%(F1%):f%=fix%(F1%):
  8167.  Calc$="" 
  8168.  Calc$=calc$(F1%)
  8169.  I%=F1%+Z% 
  8170.  F2% 
  8171.   desc%(I%-Z%)=desc%(I%):Tag$(I%-Z%)=Tag$(I%):field%(I%-Z%)=field%(I%):len%(I%-Z%)=len%(I%):chartype%(I%-Z%)=chartype%(I%):fix%(I%-Z%)=fix%(I%):calc$(I%-Z%)=calc$(I%)
  8172. jdesc%(F2%)=D%:Tag$(F2%)=T$:field%(F2%)=F%:len%(F2%)=L%:chartype%(F2%)=C%:fix%(F2%)=f%:calc$(F2%)=Calc$
  8173. icon_design(char%,func%,
  8174.  func% 
  8175.  0:bfg%=&1700A53B:ffg%=&0700A535:
  8176.  logosloaded% 
  8177.  lfg%=&0000011A 
  8178.  lfg%=ffg%
  8179.  1:bfg%=&1700653B:ffg%=&07006535:
  8180.  logosloaded% 
  8181.  lfg%=&0000611E 
  8182.  lfg%=ffg%
  8183.  char% 
  8184.  9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30:
  8185. F  !block%=keypadW%:block%!4=char%-9:
  8186.  "Wimp_GetIconState",,block%
  8187. ?  w%=block%!16-block%!8:h%=block%!20-block%!12:iflags%=bfg%
  8188.  32,33,34:w%=112:h%=44:iflags%=bfg%
  8189.  35:w%=80:h%=64:iflags%=bfg%
  8190.  31:w%=44:h%=44:iflags%=&1700B53B
  8191.  36,37,38:w%=48:h%=44:iflags%=bfg%
  8192.  39:iflags%=ffg%
  8193.  func%=0 
  8194.  iflags%=&0700A53E 
  8195.  iflags%=ffg%
  8196.  41,42,43,44,45:w%=52:h%=52:iflags%=&1700B53B
  8197.  59:iflags%=lfg%
  8198. :iflags%=ffg%
  8199.  w%=0 
  8200.  h%=0 
  8201.  iflags%=&00000000
  8202. get_field(ic%)
  8203.  F%+=1
  8204.  field%(F%)=ic% 
  8205.  desc%(F%)=ic%
  8206. adjust_on(on%)
  8207. design%=on%:adjust%=on%
  8208. lit(menu%(9),5,on%)
  8209. lit(menu%(9),1,
  8210.  on%)
  8211. lit(menu%(9),2,
  8212.  on%)
  8213. lit(menu%(9),3,
  8214.  on%)
  8215. lit(menu%(9),4,
  8216.  on%)
  8217. icon_bit(22,createW%,6,
  8218.  on%)
  8219. change_length(NL%,msg%)
  8220.  EX%,klm%,S$,N%
  8221. EX%=NL%-RA%
  8222.  EX%=0 
  8223. *dbasehandle%=
  8224. ($database%+".Database")
  8225. readsmarray(dbasehandle%,RA%)
  8226.  msg%:
  8227. extend_dbase
  8228.  (EX%>0):
  8229. confirm("Extend file from "+
  8230. (RA%)+" to "+
  8231. (NL%)+" records")=
  8232. extend_dbase
  8233.  (EX%<0):
  8234. confirm("Shorten file from "+
  8235. (RA%)+" to "+
  8236. (NL%)+" records")=
  8237. shorten_dbase
  8238. $Records%=
  8239. (RA%):N%=RA%
  8240. writesmarray(dbasehandle%,N%)
  8241. close_file(dbasehandle%)
  8242.  msg% 
  8243.  addr=
  8244. moveto(key%,top,1)
  8245. extend_dbase
  8246.  end%,P%,I%,key%,keybase%,KLM%,S$
  8247.  key%=0 
  8248.  Keys%
  8249.   S$=
  8250. KL%(key%),".")
  8251.   KLM%=KL%(key%)+13
  8252.   P%=LH%+48+(NL%+1)*KLM%
  8253. extend_named_sliding_block(keyanchor%(key%),P%)
  8254. 0   keybase%=!keyanchor%(key%)
  8255.   P%=LH%+48+RA%*KLM%
  8256.  I%=RA% 
  8257.  EX%+RA%-1
  8258.     !(keybase%+P%)=P%+KLM%
  8259.     !(keybase%+P%+4)=0
  8260.     $(keybase%+P%+8)=S$
  8261. 6%    !(keybase%+P%+KL%(key%)+9)=I%
  8262.     P%+=KLM%
  8263.   !(keybase%+P%)=0
  8264.   !(keybase%+P%+4)=0
  8265.   $(keybase%+P%+8)=S$
  8266. <"  !(keybase%+P%+KL%(key%)+9)=0
  8267.  key%
  8268. end%=
  8269. #dbasehandle%
  8270.  I%=0 
  8271.  EX%-1
  8272. #dbasehandle%=end%+I%*Length%
  8273.  J%=1 
  8274.  fields%
  8275. #dbasehandle%,""
  8276. #dbasehandle%=end%+EX%*Length%
  8277. RA%=NL%
  8278. shorten_dbase
  8279.  P%,L%,R%,s$,key%,keybase%,S$
  8280.  key%=0 
  8281.  Keys%
  8282.   S$=
  8283. KL%(key%),".")
  8284.   KLM%=KL%(key%)+13
  8285. N   keybase%=!keyanchor%(key%)
  8286. O$  s$=$(keybase%+LH%+56+NL%*KLM%)
  8287.  s$<>S$ 
  8288. confirm(
  8289. msg(52))=
  8290.   P%=LH%+48+NL%*KLM%
  8291.   !(keybase%+P%)=0
  8292.   !(keybase%+P%+4)=0
  8293.   $(keybase%+P%+8)=S$
  8294. U"  !(keybase%+P%+KL%(key%)+9)=0
  8295.  key%
  8296. #dbasehandle%=Length%*(NL%+1)
  8297. RA%=NL%
  8298. copy_database_spritefile(path$,leaf$)
  8299.  sprites%
  8300. create_named_sliding_block(sprsanchor%,1024)
  8301.  ### This is a temporary sprite area used simply to hold ###
  8302.  ### the sprite 'new_appl' whilst it is renamed and saved ###
  8303. sprites%=!sprsanchor%
  8304. !sprites%=1024
  8305. sprites%!8=16
  8306.  ### Initialise sprite area ###
  8307.  "OS_SpriteOp",&109,sprites%
  8308.  ### Load !Sprites file from Resources ###
  8309.  "OS_SpriteOp",&10A,sprites%,"<PBase$Dir>.Resources.Temp.!Sprites"
  8310.  ### Rename sprite 'new_appl' to new database name ###
  8311.  "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
  8312.  ### Save spritefile (with renamed new_appl) as !Sprites ###
  8313.  "OS_SpriteOp",&10C,sprites%,path$+".!Sprites"
  8314.  ### Do same for hi-res sprite ###
  8315.  "OS_SpriteOp",&109,sprites%
  8316.  "OS_SpriteOp",&10A,sprites%,"<PBase$Dir>.Resources.Temp.!Sprites22"
  8317.  "OS_SpriteOp",&11A,sprites%,"new_appl",leaf$
  8318.  "OS_SpriteOp",&10C,sprites%,path$+".!Sprites22"
  8319. scrap_sliding_block(sprsanchor%)
  8320. defaults(f$,N%,key%)
  8321. $Records%=
  8322. make_empty_index(N%,key%,
  8323. save_recs(f$+".Database",N%)
  8324. present%=7:
  8325. save_keys
  8326. design%=
  8327. get_it_in(f$)
  8328. lit(menu%(0),2,
  8329. default_key
  8330. first_field
  8331.  chartype%(F%)=3:KL%(0)=len%(F%)
  8332.  len%(F%)>3:KL%(0)=4
  8333. :KL%(0)=len%(F%)
  8334. Index$(0)="PrimaryKey"
  8335. key%=0
  8336. !KW%()=0:KW%(key%,0)=KL%(key%)
  8337.  KF%(key%,0)=F%:KF%(key%,1)=0
  8338. set_keydata(key%)
  8339. new_tree(f%)
  8340.  REC%,I%,ptr%,file%,old$
  8341. old$="Length: "+
  8342. (KL%(0))+", Field(s): "+Tag$(KF%(0,0))+" "+Tag$(KF%(0,1))+", Chars: "+
  8343. (KW%(0,0))+","+
  8344. (KW%(0,1))+","+
  8345. (KW%(0,2))+","+
  8346. (KW%(0,3))
  8347. selected(keyW%,9):s%=
  8348. selected(keyW%,8)
  8349.  f%=0
  8350. M$="Build index with "
  8351.  M$+="records in same subfiles" 
  8352.  M$+="all records in subfile "+
  8353. M$+=" of current database"
  8354.  M$+=", also restoring 'deleted' records."
  8355.  M$+=" WARNING! Other indices will need rebuilding!"
  8356. confirm(M$)=
  8357. mark_files(0,RA%,
  8358.  d%,s%,f%)
  8359. copy_keydata(0)
  8360. "RA%=
  8361. ($Records%):f$=$database%
  8362. scrap_sliding_block(keyanchor%(0))
  8363. make_empty_index(RA%,0,
  8364. close_window(keyW%)
  8365. redraw(keypadW%)
  8366. ptr%=!tempanchor%
  8367. poll:
  8368.  "Hourglass_On"
  8369. *dbasehandle%=
  8370. ($database%+".Database")
  8371.  REC%=0 
  8372.  RA%-1
  8373.   file%=ptr%?REC%
  8374.  file%<>255 
  8375.     top=8*file%+LH%
  8376. '    
  8377. readsmarray(dbasehandle%,REC%)
  8378.     KEY$=
  8379. key2(0,1)
  8380.      kl%=KL%(0):val$=
  8381. type(0)
  8382. &    
  8383.  KEY$<>"" 
  8384. insert(
  8385. ,KEY$,0)
  8386.  "Hourglass_Percentage",(REC%*100) 
  8387.  REC%
  8388. close_file(dbasehandle%)
  8389. "newtree%=
  8390. :design%=
  8391. :adjust%=
  8392. scrap_sliding_block(tempanchor%)
  8393.  "Hourglass_Off"
  8394. present%=7
  8395. selected(passW%,16) 
  8396. #loghandle%,"Primary key altered. Previous structure was:"
  8397. #loghandle%,old$
  8398.  "Wimp_CreateMenu",,-1
  8399. *block%!8=0:block%!12=wi%:block%!16=ic%
  8400.  "Interface_SlabButton",,block%
  8401. get_it_in($database%)
  8402. reformat(f$)
  8403.  I%,F,REC%,dfields%,DLength%,chdd,z%,blobs%,ex%
  8404.  DTag$(),F%(),F1%(),L%(),l$(),c$()
  8405. F$(0)=""
  8406.  "OS_File",5,f$+".Form" 
  8407.  z%<>1:
  8408. softerror("",19)
  8409.  f$=$database%:
  8410. softerror("",36)
  8411. $  blobs%=
  8412. find_blobs($database%)
  8413. (f$+".Form")
  8414. #F,dfields%
  8415.  DTag$(dfields%),F%(dfields%),F1%(fields%),L%(dfields%),l$(dfields%),c$(dfields%)
  8416.  I%=1 
  8417.  dfields%
  8418. F    
  8419. #F,Desc$,DTag$(I%),xd%,yd%,xf%,yf%,L%(I%),char%,extra%,extra%
  8420.     DLength%+=L%(I%)+1
  8421.   chdd=
  8422. (f$+".Database")
  8423. compare
  8424.  "Hourglass_On"
  8425.  REC%=0 
  8426. #chdd=REC%*DLength%
  8427. (    
  8428. read(fields%,
  8429. ,REC%,$database%)
  8430.  I%=1 
  8431.  dfields%
  8432.       S$=field$(F%(I%))
  8433. )      
  8434. (S$)>L%(I%) 
  8435. S$,L%(I%))
  8436.       
  8437. #chdd,S$
  8438.     ex%=-1
  8439.  ex%<blobs%
  8440.       ex%+=1:F%=Ext%(ex%)
  8441. F      
  8442. copy_blob($database%,f$,REC%,REC%,F%,F1%(F%),chartype%(F%))
  8443.         
  8444. 2    
  8445.  "Hourglass_Percentage",(REC%*100) 
  8446.  REC%
  8447.  "Hourglass_Off"
  8448. close_file(chdd)
  8449.  "OS_File",18,f$+".Database",&7f2
  8450.  "OS_CLI","Copy "+$database%+".PrimaryKey "+f$+".PrimaryKey ~C~V"
  8451.  "OS_CLI","Copy "+$database%+".Colours "+f$+".Colours ~C~V"
  8452.  "OS_CLI","Copy "+$database%+".ValTables "+f$+".ValTables ~CR~V"
  8453.  "OS_CLI","Copy "+$database%+".Indices "+f$+".Indices ~CR~V"
  8454.  "OS_CLI","Copy "+$database%+".PrintRes "+f$+".PrintRes ~CR~V"
  8455.  link$(0)="LOADED" 
  8456.     lk=
  8457. (f$+".Link")
  8458.  F%=1 
  8459.  dfields%
  8460.       
  8461. #lk,l$(F%)
  8462. close_file(lk)
  8463.  calc$(0)="LOADED" 
  8464.     cl=
  8465. (f$+".Calc")
  8466.  F%=1 
  8467.  dfields%
  8468.       
  8469. #cl,c$(F%)
  8470. close_file(cl)
  8471. close_window(reformW%)
  8472. reform$=""
  8473. selected(passW%,16) 
  8474. #loghandle%,"Record structure changed"
  8475. compare
  8476.  source%,dest%
  8477.  dest%=1 
  8478.  dfields%
  8479.   source%=fields%+1
  8480.     source%-=1
  8481.  source%=0 
  8482.  Tag$(source%)=DTag$(dest%)
  8483. *  F%(dest%)=source%:F1%(source%)=dest%
  8484.  source%>0 
  8485.      l$(dest%)=link$(source%)
  8486.      c$(dest%)=calc$(source%)
  8487.  dest%
  8488. merge_files(f$,fi%)
  8489.  Rec%,ptr%,file%,d%,s%,z%,RUM%,RAM%,NL%,ex%,blobs%
  8490.  "OS_File",5,f$+".Database" 
  8491.  z%<>1:
  8492. softerror("",29)
  8493.  f$=$database%:
  8494. softerror("",15)
  8495. identical:
  8496. softerror("",21)
  8497. 7  s%=
  8498. selected(reformW%,2):d%=
  8499. selected(reformW%,3)
  8500.  fi%=0
  8501.   M$="Merge "+f$+" with "
  8502.  M$+="corresponding subfiles" 
  8503.  M$+="subfile "+
  8504. (fi%)
  8505.    M$+=" of current database"
  8506.  M$+=", also restoring deleted records"
  8507.  M$+=". WARNING! Indices will need rebuilding!"
  8508. confirm(M$)=
  8509. 0    
  8510.  "OS_File",5,f$+".Database" 
  8511.  ,,,,len%
  8512.     RAM%=(len% 
  8513.  Length%)-1
  8514. 0    
  8515. open_index(f$+".PrimaryKey",MaxKeys%+1)
  8516. 0    
  8517. mark_files(MaxKeys%+1,RAM%,
  8518.  d%,s%,fi%)
  8519. (    keybase%=!keyanchor%(MaxKeys%+1)
  8520.  -    
  8521. count(MaxKeys%+1,RUM%):
  8522. count(0,RU%)
  8523.     NL%=RU%+RUM%
  8524.  "Hourglass_On"
  8525. #)    
  8526.  NL%>RA% 
  8527. change_length(NL%,
  8528. $&    blobs%=
  8529. find_blobs($database%)
  8530.     ptr%=!tempanchor%
  8531.  Rec%=0 
  8532.  RAM%-1
  8533.       file%=ptr%?Rec%
  8534.       
  8535.  file%<>255 
  8536.         top=8*file%+LH%
  8537. *$        
  8538. read(fields%,
  8539. ,Rec%,f$)
  8540. +         
  8541. write(fields%,key%)
  8542.         ex%=-1
  8543.         
  8544.  ex%<blobs%
  8545. .!          ex%+=1:F%=Ext%(ex%)
  8546. /E          
  8547. copy_blob(f$,$database%,Rec%,REC%,F%,F%,chartype%(F%))
  8548.         
  8549. 17        
  8550.  "Hourglass_Percentage",(Rec%*100) 
  8551.  RUM%
  8552.       
  8553.  Rec%
  8554.  "Hourglass_Off"
  8555. close_window(reformW%)
  8556. 6)    
  8557. scrap_sliding_block(tempanchor%)
  8558. 74    
  8559. scrap_sliding_block(keyanchor%(MaxKeys%+1))
  8560. 8!    file%=fi%:top=8*file%+LH%
  8561. 9     addr=
  8562. moveto(key%,top,1)
  8563. reform$=""
  8564. selected(passW%,16) 
  8565. #loghandle%,"Records merged from "+f$
  8566. identical
  8567.  I%,F,dfields%,different%
  8568. (f$+".Form")
  8569. #F,dfields%
  8570.  dfields%<>fields% 
  8571.  different%=
  8572.  I%<fields% 
  8573.  different%
  8574.   I%+=1
  8575. #F,Desc$,Tag$,xd%,yd%,xf%,yf%,len%,char%,extra%,extra%
  8576.  len%<>len%(I%) 
  8577.  different%=
  8578.  different%
  8579. mark_files(key%,RA%,d%,s%,f%)
  8580.  P%,I%,M,file%,top,ptr%
  8581. create_named_sliding_block(tempanchor%,RA%+1)
  8582.  "Hourglass_On"
  8583. ptr%=!tempanchor%
  8584.  I%=0 
  8585.  RA%-1
  8586.   ptr%?I%=d%
  8587.  file%=0 
  8588.     top=8*file%+LH%
  8589. X!    P%=
  8590. neighbour(key%,top,1)
  8591.  P%<>top
  8592. Z       S%=
  8593. rec_no(k$,key%,P%)
  8594. [+      
  8595.  ptr%?S%=file% 
  8596.  ptr%?S%=f%
  8597. \"      P%=
  8598. neighbour(key%,P%,1)
  8599. ]        
  8600.  file%
  8601.  "Hourglass_Off"
  8602. print_tree(key%,file%,PR$)
  8603.  L%(),COL%,levels%,depth%
  8604. read_print_options
  8605. reportdest$="Window"
  8606. keybase%=!keyanchor%(key%)
  8607. P%=!(keybase%+top)
  8608.  "Hourglass_On"
  8609. traverse(P%,
  8610. levels%=depth%-2:COL%=0
  8611.  L%(levels%)
  8612. tree_heading
  8613. P%=!(keybase%+top)
  8614. traverse(P%,
  8615. H$=" No. nodes     1"
  8616. H1$=" Max nodes     1"
  8617.  L%=1 
  8618.  levels%
  8619.  L%<40 
  8620.     L$=
  8621. (L%(L%))
  8622.     L$=
  8623. (L$)," ")+L$
  8624.     M$=
  8625. (2^L%)
  8626. w0    
  8627. (M$)>5 
  8628.  M$=BL$ 
  8629. (M$)," ")+M$
  8630.     H$+=L$:H1$+=M$
  8631. rule_off(45)
  8632. |:$(!lineanchor%)=H$:
  8633. list_line(-1,lineanchor%,
  8634. (H$),32)
  8635. }<$(!lineanchor%)=H1$:
  8636. list_line(-1,lineanchor%,
  8637. (H1$),32)
  8638. ~<$(!lineanchor%)=LH$:
  8639. list_line(-1,lineanchor%,
  8640. (LH$),32)
  8641. rule_off(45)
  8642.  "Hourglass_Off"
  8643. format$="tree":tkey%=key%
  8644. screen_list
  8645. pitch$=
  8646. pitch("2")
  8647. lit(menu%(18),1,
  8648. tree_heading
  8649.  zero%,len%
  8650. 6," ")
  8651. LH$=" Level No.  Root"
  8652.  L%=1 
  8653.  levels%
  8654.   L$=
  8655.  L%<10 
  8656.  L$="0"+L$
  8657.  L%<40 
  8658.     LH$+="    "+L$
  8659.     len%=
  8660. (LH$)
  8661. U$=" "+
  8662. len%-1,"-")
  8663. LenLine%=len%+4
  8664. Count%=0
  8665. "count%=
  8666. count_recs(key%,zero%)
  8667. Dtextblocksize%=(count%+11)*LenLine%:textblockinc%=textblocksize%
  8668. extend_named_sliding_block(textanchor%,textblocksize%)
  8669. extend_named_sliding_block(lineanchor%,LenLine%+4)
  8670. TextPtr%=!textanchor%
  8671. recblocksize%=400
  8672. extend_named_sliding_block(recanchor%,recblocksize%)
  8673. rule_off(32)
  8674. rule_off(45)
  8675. send_title("Tree Analysis (subfile:"+
  8676. (file%)+", key:"+
  8677. (key%)+", "+Index$(key%)+")")
  8678. rule_off(32)
  8679. <$(!lineanchor%)=LH$:
  8680. list_line(-1,lineanchor%,
  8681. (LH$),32)
  8682. rule_off(45)
  8683. traverse(P%,Z%)
  8684.  string$
  8685. COL%=COL%+1
  8686.  COL%>depth% 
  8687.  depth%=COL%
  8688.  P%<0 
  8689. L%=!(keybase%+P%)
  8690. R%=!(keybase%+P%+4)
  8691. S$=$(keybase%+P%+8)
  8692.  S$="" 
  8693.  S$="<null>"
  8694. %rec%=!(keybase%+P%+8+KL%(key%)+1)
  8695.   L%(COL%-1)=L%(COL%-1)+1
  8696.  PR$="ALL" 
  8697.  COL%<=40 
  8698. *      string$=
  8699. COL%*6+10-
  8700. (S$)," ")+S$
  8701. L      $(!lineanchor%)=string$:
  8702. list_line(rec%,lineanchor%,
  8703. (string$),32)
  8704.       
  8705. 1      string$=" "+S$+" (level "+
  8706. (COL%-1)+")"
  8707. L      $(!lineanchor%)=string$:
  8708. list_line(rec%,lineanchor%,
  8709. (string$),32)
  8710.         
  8711. traverse(L%,Z%)
  8712. COL%=COL%-1
  8713. L%=!(keybase%+P%)
  8714. R%=!(keybase%+P%+4)
  8715. S$=$(keybase%+P%+8)
  8716. %rec%=!(keybase%+P%+8+KL%(key%)+1)
  8717. traverse(R%,Z%)
  8718. COL%=COL%-1
  8719. balance(key%)
  8720.  recptr%,top,file%,flagptr%,balptr%,I%,N%,A%,max%,done%,highest%,avail%,seglen%
  8721.  recs%(),ptr%()
  8722.  recs%(5),ptr%(5)
  8723. newtree%=
  8724. seglen%=KL%(key%)+5
  8725. extend_named_sliding_block(recanchor%,seglen%*RA%)
  8726. create_named_sliding_block(balanchor%,seglen%*RA%)
  8727. create_named_sliding_block(flaganchor%,RA%)
  8728. Arecptr%=!recanchor%:flagptr%=!flaganchor%:balptr%=!balanchor%
  8729.  I%=0 
  8730.  RA%-1
  8731.   flagptr%?I%=255
  8732.  Bytes are changed from 255 to 0 where records are in use
  8733.  "Hourglass_On"
  8734.  file%=0 
  8735.   ptr%(file%)=recptr%
  8736.   top=8*file%+LH%
  8737. .  recs%(file%)=
  8738. count_recs(key%,recptr%)-1
  8739.   max%+=recs%(file%)+1
  8740.  file%
  8741. make_empty_index(RA%,key%,
  8742.  "Hourglass_LEDs",%11
  8743.  file%=0 
  8744.   top=8*file%+LH%
  8745.  recs%(file%)>=0 
  8746.     recptr%=ptr%(file%)
  8747.     N%=1
  8748.         
  8749.       N%=N%+N%
  8750.  N%>recs%(file%)+2
  8751.     step%=N%
  8752.     N%=(N% 
  8753.  2)-1
  8754.     start%=N%
  8755.     C%=0
  8756.         
  8757.       start%=start% 
  8758.       end%=N%-start%-1
  8759.       step%=step% 
  8760. $      
  8761.  I%=start% 
  8762.  end% 
  8763.  step%
  8764. 9        A%=recptr%+seglen%*(I%*(recs%(file%)+1) 
  8765. =        balptr%!C%=!A%:$(balptr%+C%+4)=$(A%+4):!A%=-!A%-1
  8766.         C%+=seglen%
  8767.       
  8768.  step%=2
  8769. &    kl%=KL%(key%):val$=
  8770. type(key%)
  8771. %    
  8772.  I%=0 
  8773.  C%-seglen% 
  8774.  seglen%
  8775. .      REC%=balptr%!I%:KEY$=$(balptr%+I%+4)
  8776.       
  8777. insert(
  8778. ,KEY$,key%)
  8779.       done%+=1
  8780. 6      
  8781.  "Hourglass_Percentage",(done%*100) 
  8782.  max%
  8783.  I%=0 
  8784.  recs%(file%)
  8785. #      REC%=recptr%!(seglen%*I%)
  8786.       
  8787.  REC%>=0 
  8788. (        KEY$=$(recptr%+seglen%*I%+4)
  8789.          
  8790. insert(
  8791. ,KEY$,key%)
  8792.         done%+=1
  8793. 8        
  8794.  "Hourglass_Percentage",(done%*100) 
  8795.  max%
  8796.       
  8797.  file%
  8798.  "Hourglass_LEDs",%00
  8799. keybase%=!keyanchor%(key%)
  8800. nodesize%=8+KL%(key%)+1+4
  8801. avail%=!keybase%
  8802.  I%=0 
  8803.  highest%
  8804.  flagptr%?I%=255 
  8805. +    !(keybase%+avail%+8+KL%(key%)+1)=I%
  8806.     avail%+=nodesize%
  8807.  "Hourglass_Off"
  8808. scrap_sliding_block(balanchor%)
  8809. scrap_sliding_block(recanchor%)
  8810. scrap_sliding_block(flaganchor%)
  8811. save_keys
  8812. newtree%=
  8813. selected(passW%,16) 
  8814. #loghandle%,"Index "+Index$(key%)+" balanced"
  8815. duplicates(dkey%,dfile%)
  8816.  P$,S$,RP$,RS$,daddr,dtop,RP%,RS%,count%,examined%
  8817. abort_dup:
  8818. "count%=
  8819. count_recs(key%,zero%)
  8820. read_print_options
  8821. Breportdest$="Window":format$="dup":Count%=0:LenLine%=KL%(0)+23
  8822. <textblocksize%=100*LenLine%:textblockinc%=textblocksize%
  8823. extend_named_sliding_block(textanchor%,textblocksize%)
  8824. extend_named_sliding_block(lineanchor%,LenLine%+4)
  8825. TextPtr%=!textanchor%
  8826. recblocksize%=400
  8827. extend_named_sliding_block(recanchor%,recblocksize%)
  8828. close_window(datadicW%)
  8829. rule_off(32)
  8830. &aline$=" Duplicated primary keys":$(!lineanchor%)=line$:
  8831. list_line(-1,lineanchor%,
  8832. (line$),32)
  8833. rule_off(45)
  8834. dtop=8*dfile%+LH%
  8835. )"daddr=
  8836. neighbour(dkey%,dtop,1)
  8837.  "Hourglass_On"
  8838.  daddr<>dtop
  8839.  "OS_Byte",229,0
  8840. -S  S$=$(!keyanchor%(dkey%)+daddr+8):RS%=!(!keyanchor%(dkey%)+daddr+9+KL%(dkey%))
  8841. .;  RS$=
  8842. (RS%):RS$=" Record No."+
  8843. (RS$)," ")+RS$+"   "
  8844.  S$=P$ 
  8845.     line$=RP$+P$
  8846. 1E    $(!lineanchor%)=line$:
  8847. list_line(RP%,lineanchor%,
  8848. (line$),32)
  8849.     line$=RS$+S$
  8850. 3E    $(!lineanchor%)=line$:
  8851. list_line(RS%,lineanchor%,
  8852. (line$),32)
  8853.   P$=S$:RP%=RS%:RP$=RS$
  8854.   examined%+=1
  8855.  "Hourglass_Percentage",examined%*100 
  8856.  count%
  8857. 8%  daddr=
  8858. neighbour(dkey%,daddr,1)
  8859. rule_off(32)
  8860.  "Hourglass_Off"
  8861. screen_list
  8862. abort_dup
  8863.  "Hourglass_Off"
  8864. screen_list
  8865. softerror("",67)
  8866. wimp_error(
  8867. stripspaces(s$)
  8868. s$)=" "
  8869.   s$=
  8870.  >RAMtree
  8871.  Index handling ------------------------------------------------------
  8872. neighbour(key%,addr%,d%)
  8873.  R%,S%,p%,keybase%
  8874. keybase%=!keyanchor%(key%)
  8875. p%=d%*4
  8876. R%=!(keybase%+addr%+p%)
  8877.  R%<0 
  8878.  =-R%
  8879. p%=4-p%
  8880.   addr%=R%
  8881.   S%=!(keybase%+addr%+p%)
  8882.  S%>0 
  8883.  R%=S%
  8884.  S%<=0
  8885. rec_no(
  8886.  k$,key%,addr%)
  8887. b#k$=$(!keyanchor%(key%)+addr%+8)
  8888. c-=!(!keyanchor%(key%)+addr%+8+KL%(key%)+1)
  8889. scan_file(c$,key%,action%)
  8890.  REC%,examined%,subtotal%,X%,Y%,n$
  8891. n$="0123456789."
  8892. h%subtotal%=
  8893. count_recs(key%,zero%)
  8894. (c$)=
  8895.  "OS_Byte",229,0
  8896.   REC%=
  8897. rec_no(k$,key%,P%)
  8898. readsmarray(dbasehandle%,REC%)
  8899.   examined%+=1
  8900. (Search$)=
  8901.  action% 
  8902.       
  8903. get_lengths
  8904. q!      
  8905. print_record(REC%)
  8906. r-      
  8907.  2:ptr%?REC%=255:
  8908.  ### earmark ###
  8909. s"      
  8910. write_csv_rec(REC%)
  8911. t;      
  8912.  4:KEY$=
  8913. key2(newkey%,1):
  8914. insert(
  8915. ,KEY$,newkey%)
  8916. u       
  8917.  ### create index ###
  8918.       
  8919.       S$=F$(Fieldnumber%)
  8920.       
  8921.  numeric% 
  8922.         X%=0:Y%=0
  8923.         
  8924.  X%+=1
  8925. {)        
  8926. (S$) 
  8927. S$,X%,1))>0
  8928.         
  8929.  X%<=
  8930. (S$) 
  8931.           Y%=X%
  8932.           
  8933.  Y%+=1
  8934. +          
  8935. (S$) 
  8936. S$,Y%,1))=0
  8937.         
  8938. ;        S$=
  8939. S$,X%-1)+
  8940. S$,X%,Y%-X%)+New$))+
  8941. S$,Y%)  
  8942.         
  8943.  S$=New$
  8944.       
  8945.       
  8946. (S$)>TextLength% 
  8947.         
  8948. softerror("",10)
  8949.         
  8950.         F$(Fieldnumber%)=S$
  8951. ,        
  8952. writesmarray(dbasehandle%,REC%)
  8953.       
  8954. !      
  8955.  ### global change ###
  8956.         
  8957.   P%=
  8958. neighbour(key%,P%,1)
  8959.  "Hourglass_Percentage",(examined%*100) 
  8960.  subtotal%
  8961. search(S$,key%,M%)
  8962.  P%,found%,info$,keybase%
  8963. keybase%=!keyanchor%(key%)
  8964. Z%=0:P%=top:ident%=
  8965.   L%=P%
  8966.   P%=!(keybase%+L%+Z%)
  8967.  P%<=0 
  8968.  P%=-L%:found%=
  8969.   info$=$(keybase%+P%+8)
  8970.   rec%=
  8971. rec_no(k$,key%,P%)
  8972. (val$+"(S$)="+val$+"LEFT$(info$,kl%)") 
  8973.       
  8974.  0:ident%=(key%=0)
  8975.       
  8976.  1:found%=
  8977. $      
  8978.  rec%=REC% 
  8979.  found%=
  8980.         
  8981.  found% 
  8982.  Z%=-
  8983. (val$+"(S$)>="+val$+"(info$)")*4
  8984.  found%
  8985.  ### M%=0 - Find leaf position at which to insert ###
  8986.  ### M%=1 - Find first match in tree (if there is one) ###
  8987.  ### M%=2 - Find exact matching record, checking for record no. ###
  8988. insert(R%,
  8989.  S$,key%)
  8990.  P%,A%,kl%,keybase%,abort%
  8991. keybase%=!keyanchor%(key%)
  8992. kl%=KL%(key%)
  8993. A%=!keybase%:F%=A%
  8994. search(S$,key%,0)
  8995.  ident% 
  8996. !    
  8997. selected(passW%,15):
  8998. +    
  8999. softerror(" ("+S$+")",37):abort%=
  9000. >    
  9001.  dup% 
  9002. confirm(
  9003. msg(45)+" ("+S$+")") 
  9004.  abort%=
  9005.  abort% 
  9006.  S$="*Failed*":
  9007.  !(keybase%+F%)>0 
  9008.   A%=!(keybase%+F%)
  9009.   incr%=
  9010. ($Increment%)
  9011.  incr%>0 
  9012. #    
  9013. change_length(RA%+incr%,
  9014. "    keybase%=!keyanchor%(key%)
  9015.     A%=!keybase%:F%=A%
  9016.  S$="*Failed*"
  9017.  S$="*Failed*" 
  9018. softerror("",2):
  9019.  REC%=!(keybase%+F%+8+kl%+1)
  9020. '!(keybase%+F%+Z%)=!(keybase%+P%+Z%)
  9021. !(keybase%+F%+(4-Z%))=-P%
  9022. $(keybase%+F%+8)=S$
  9023. %!(keybase%+F%+8+KL%(key%)+1)=REC%
  9024. !(keybase%+P%+Z%)=F%
  9025. !keybase%=A%
  9026.  key%=0 
  9027.  RU%+=1
  9028. delete(
  9029.  S$,key%)
  9030.  P%,A%,kl%,keybase%
  9031. keybase%=!keyanchor%(key%)
  9032. A%=!keybase%
  9033. kl%=KL%(key%)
  9034. search(S$,key%,2)
  9035.  P%<0 
  9036. softerror(" ("+S$+": "+Index$(key%)+" index)",1):S$="*Failed*":
  9037. neighbour(key%,P%,0)
  9038. neighbour(key%,P%,1)
  9039. '!(keybase%+L%+Z%)=!(keybase%+P%+Z%)
  9040.     Q%=P%
  9041. ZL%=4-Z%
  9042. P1%=!(keybase%+P%+ZL%)
  9043.  P1%>0 
  9044.   info$=$(keybase%+P1%+8)
  9045.   P%=-
  9046. search(info$,key%,0)
  9047.   !(keybase%+P%+Z%)=P1%
  9048.  !(keybase%+PR%+4)<=0 
  9049.  !(keybase%+PR%+4)=-SU%
  9050.  !(keybase%+SU%+0)<=0 
  9051.  !(keybase%+SU%+0)=-PR%
  9052. !(keybase%+Q%)=A%
  9053. !keybase%=Q%
  9054.  key%=0 
  9055.  RU%-=1
  9056. save_keys
  9057.  keyN%
  9058.  present%<>7 
  9059.  "Hourglass_On"
  9060. 5keybase%=!keyanchor%(0):keybase%!4=
  9061. ($Increment%)
  9062.  !keyanchor%(keyN%)>0
  9063. !  keybase%=!keyanchor%(keyN%)
  9064. !  keybase%?72=0:keybase%?73=0
  9065.  "SlidingHeap_DescribeBlock",slidingheapbase%,keyanchor%(keyN%) 
  9066.  ,,filelength%
  9067.  keyN% 
  9068.  index$="Indices." 
  9069.  index$=""
  9070.  "OS_File",10,$database%+"."+index$+Index$(keyN%),&7F0,,keybase%,keybase%+filelength%
  9071.   keyN%+=1
  9072.  "Hourglass_Percentage",keyN%*100 
  9073.  (Keys%+1)
  9074.  "Hourglass_Off"
  9075. readsmarray(filehandle%,REC%)
  9076.  loop%
  9077. #filehandle%=REC%*Length%
  9078.  loop%=1 
  9079.  fields%
  9080.   F$(loop%)=
  9081. #filehandle%
  9082.  loop%
  9083. writesmarray(F,
  9084.  loop%
  9085. #F=R%*Length%
  9086.  loop%=1 
  9087.  fields%
  9088. #F,F$(loop%)
  9089.  loop%
  9090.     R%+=1
  9091. check_save(T%)
  9092.  time%
  9093.  "OS_ReadMonotonicTime" 
  9094.  time%
  9095.  (time% 
  9096.  T%)<10 
  9097.  buttonfield%(19)>0 
  9098.  wi%=mainW%:ic%=buttonfield%(19) 
  9099.  wi%=keypadW%:ic%=19
  9100.  autosave% 
  9101.     delay%=
  9102.  loop%=0 
  9103.       delay%+=50
  9104. 0      block%!8=1:block%!12=wi%:block%!16=ic%
  9105. +      
  9106.  "Interface_SlabButton",,block%
  9107.       
  9108. >delay%
  9109.       
  9110.  1,-15,180,5
  9111.       block%!8=0
  9112. +      
  9113.  "Interface_SlabButton",,block%
  9114.       delay%+=50
  9115.       
  9116. >delay%
  9117.  loop%
  9118. !    
  9119. mouse(0,0,4,wi%,ic%)
  9120. set_auto(mode%)
  9121. tick_one(menu%(12),0,2,2-mode%)
  9122. autosave%=mode%
  9123. &8saveint%=
  9124. ($Interval%):$Interval%=
  9125. (saveint%)+" min"
  9126. set_autobalance(status%)
  9127. tick(menu%(21),0,status%)
  9128. autobalance%=status%
  9129.  autobalance% 
  9130.  $Every%="25 recs"
  9131. -:balint%=
  9132. ($Every%):$Every%=
  9133. (balint%)+" recs":added%=0
  9134.  Calculations ---------------------------------------------------------
  9135. calc_link(T$,type%)
  9136.  ### Sets up calculation formula window & menu entry ###
  9137. $CalcFunc%=T$
  9138. 5)$CalcTitle%=T$:calclink%=Fieldnumber%
  9139. split_link(calclink%,real$,visible$)
  9140.  type% 
  9141.  6,7:$CalcForm%=Tag$(calclink%)+"="+visible$
  9142.   $CalcForm%=visible$
  9143. icon_bit(22,calcW%,2,off%)
  9144. deselect(calcW%,2)
  9145. calc_formula(S$)
  9146.  ### Parses calculation formula (S$) & builds calc$(I%) ###
  9147.  I%,P%,t$,s$,C$,time%
  9148. C/C$=
  9149. ~(calclink%):
  9150.  calclink%<16 
  9151.  C$="0"+C$
  9152.  $CalcFunc%="Set base value" 
  9153.  S$="" 
  9154.  S$="0"
  9155. F   calc$(calclink%)=S$+"|"+S$
  9156.   calc$(0)="LOADED"
  9157. I*  P%=
  9158. S$,"="):S$=
  9159. S$,P%+1):visible$=S$
  9160.  I%=1 
  9161.  fields%
  9162.     t$=Tag$(I%)
  9163.  t$<>"" 
  9164.       P%=0
  9165.       
  9166.         P%=
  9167. S$,t$,P%+1)
  9168.         
  9169.  P%>0 
  9170. Q           
  9171.  chartype%(I%) 
  9172. R>            
  9173.  3,6,46,47,54,56,57:s$="VAL($Rf%("+
  9174. (I%)+"))"
  9175. S=            
  9176.  8:s$="FNseconds($Rf%("+
  9177. (I%)+"),1)":time%=
  9178.             
  9179. U)            
  9180.  chartype%(calclink%) 
  9181. V)              
  9182.  6:s$="FNn("+
  9183. (I%)+")"
  9184. W*              
  9185.  7:s$="$Rf%("+
  9186. (I%)+")"
  9187.             
  9188.           
  9189. Z+          S$=
  9190. S$,P%-1)+s$+
  9191. S$,P%+
  9192. (t$))
  9193.           update$(I%)+=C$
  9194.         
  9195.       
  9196.  P%=0
  9197. ^        
  9198. visible$,"TIME$")>0 
  9199.  update$(0)+=C$
  9200.  time%=
  9201.  chartype%(calclink%)=7 
  9202.  S$="FNtime("+S$+")"
  9203. (S$)+
  9204. (visible$)+2<256 
  9205. c,    calc$(calclink%)="#"+S$+"#"+visible$
  9206.     calc$(0)="LOADED"
  9207. e7    
  9208. selected(calcW%,2) 
  9209. recalculate(calclink%)
  9210. softerror("",44)
  9211. calclink%=0
  9212.  (b% 
  9213.  %111)=4 
  9214.  "Wimp_CreateMenu",,-1
  9215. recalculate(F%)
  9216.  F,I%,R%,k$,P%,real$,visible$,subtotal%,zero%,examined%
  9217. split_link(F%,real$,visible$)
  9218. confirm("Recalculate "+Tag$(F%)+"="+visible$+" for existing records?")=
  9219. q%subtotal%=
  9220. count_recs(key%,zero%)
  9221.  "Hourglass_On"
  9222. s*dbasehandle%=
  9223. ($database%+".Database")
  9224. neighbour(key%,top,1)
  9225.  P%<>top
  9226.   R%=
  9227. rec_no(k$,key%,P%)
  9228. readsmarray(dbasehandle%,R%)
  9229.  I%=1 
  9230.  fields%
  9231.     $Rf%(I%)=F$(I%)
  9232.  chartype%(F%) 
  9233.     F=
  9234. (real$):F$=
  9235. ~+    
  9236.  fix%(F%)>0 
  9237. fix_point(F$,F%)
  9238. (    
  9239. softerror(real$,73):
  9240.     F$=
  9241. (real$)
  9242. (F$)<=len%(F%) 
  9243.  F$(F%)=F$
  9244. writesmarray(dbasehandle%,R%)
  9245.   P%=
  9246. neighbour(key%,P%,1)
  9247.   examined%+=1
  9248.  "Hourglass_Percentage",examined%*100 
  9249.  subtotal%
  9250.  "Hourglass_Off"
  9251. close_file(dbasehandle%)
  9252.  I%=1 
  9253.  fields%
  9254.   $Rf%(I%)=field$(I%)
  9255. display(key%,addr)
  9256. sums(
  9257.  F$,R%,type%)
  9258.  F$<>"" 
  9259.  type% 
  9260.  8:V=
  9261. seconds(F$,1)
  9262.   Sum(R%,0)+=1
  9263.   Sum(R%,1)+=V
  9264.   Sum(R%,3)+=V*V
  9265. ctotals(flag%)
  9266.  F%,I%,J%,N%,R%,S%,base%,pos%,F$
  9267.  S$(),f%()
  9268.  S$(3),f%(3)
  9269. base%=!lineanchor%
  9270. 'S$()="Items","Sum","Mean","St.Dev."
  9271.  I%=1 
  9272. (Form$)-1 
  9273.   F%=
  9274. fnum(
  9275. Form$,I%,2))
  9276.   R%=calcrow%?F%
  9277.  chartype%(F%) 
  9278.  3,6,8,46,47,54,56,57:
  9279.  Sum(R%,0)>0 
  9280. '      Sum(R%,2)=Sum(R%,1)/Sum(R%,0)
  9281. 6      Sum(R%,3)=
  9282. (Sum(R%,3)/Sum(R%,0)-Sum(R%,2)^2)
  9283.         
  9284.  J%=0 
  9285.   pos%=base%
  9286.  flag%>0 
  9287. >    N%=0:start%=1:F$=
  9288. Lmargin%-
  9289. (S$(J%))-1," ")+S$(J%)+" "
  9290.  N%=1:start%=3
  9291. &    L%=Tab%(1)-Lmargin%-
  9292. (spacer$)
  9293. N    
  9294.  L%>=7 
  9295.  F$=margin$+
  9296. tab(S$(J%),N%) 
  9297.  F$=margin$+
  9298. S$(J%),L%),N%)
  9299. heap_store(lineanchor%,LenLine%,0,pos%,0,F$)
  9300. (Form$)>2 
  9301.  start%=1 
  9302. $    
  9303.  I%=start% 
  9304. (Form$)-1 
  9305. &      F%=
  9306. fnum(
  9307. Form$,I%,2)):F$=""
  9308.       N%+=1
  9309.       
  9310.  chartype%(F%) 
  9311. #        
  9312.  3,6,8,46,47,54,56,57:
  9313.         R%=calcrow%?F%
  9314. Q        
  9315.  chartype%(F%)=8 
  9316.  result$=
  9317. time(Sum(R%,J%)) 
  9318.  result$=
  9319. (Sum(R%,J%))
  9320. T        
  9321. selected(pselectW%,R%*5-3+J%) 
  9322. justify(result$,N%,N%-1):f%(J%)=1
  9323.       
  9324. @      
  9325. heap_store(lineanchor%,LenLine%,0,pos%,0,
  9326. tab(F$,N%))
  9327. =    
  9328.  f%(J%)=1 
  9329. list_line(-1,lineanchor%,pos%-base%,32)
  9330. (f%())>0 
  9331. rule_off(45)
  9332. margin_warn
  9333.  f%,F%,R%,J%
  9334. fnum(
  9335. Form$,2))
  9336.  chartype%(F%) 
  9337.  3,6,46,47,54,56,57:
  9338.   R%=calcrow%?F%
  9339.  J%=0 
  9340. .    
  9341. selected(pselectW%,R%*5-J%) 
  9342.  f%=F%
  9343.  f%>0 
  9344.  Lmargin%<9 
  9345. softerror(" ("+Tag$(f%)+").",92):=-1
  9346. tab(F$,N%)
  9347. (F$)+
  9348. (spacer$)
  9349.  Tab%(N%)-Tab%(N%-1)-L%<=0 
  9350. =F$+spacer$
  9351. ,=F$+
  9352. Tab%(N%)-Tab%(N%-1)-L%," ")+spacer$
  9353. justify(f$,x%,x1%)
  9354. $L%=Tab%(x%)-Tab%(x1%)-
  9355. (spacer$)
  9356. (f$)>L% 
  9357. f$,L%) 
  9358. (f$)," ")+f$
  9359. execute_file(f$)
  9360.  F,P%,name$,command$,finished%,firstquery%,state%
  9361. confirm(
  9362. msg(68)) 
  9363. selected(printW%,39) 
  9364.  reportdest$="File" 
  9365.  reportdest$="Window"
  9366.  Script file signature
  9367. junk$=
  9368. abort_script:
  9369.  finished%)
  9370.  "OS_Byte",229,0
  9371.   line$=
  9372.   space%=
  9373. line$," ")
  9374.  space%=0 
  9375.  command$=line$:params$="" 
  9376.  command$=
  9377. line$,space%-1):params$=
  9378. line$,space%+1):state%=(params$="ON")
  9379.  command$ 
  9380.  "!COMMENT":
  9381.  "!SCRIPT":
  9382.     ImpCom$=""
  9383.  params$="END" 
  9384.       finished%=
  9385. :      
  9386. execute_file($database%+".PrintRes."+params$)
  9387.         
  9388.  "!DELETE":
  9389.  present%=7 
  9390.       RecF%=
  9391. 0      
  9392.  params$="" 
  9393.  key$=
  9394.  key$=params$
  9395. 5      
  9396. select(keypadW%,25):
  9397. deselect(keypadW%,24)
  9398.        addr=
  9399. find(key$,0,0,
  9400.       
  9401.  RecF%=
  9402.         addr=
  9403. shift(0,0,0)
  9404. $        addr=
  9405. moveto(key%,top,1)
  9406.       
  9407.         
  9408.  "!INSERT":
  9409.  present%=7 
  9410.       subfile%=
  9411. (params$)
  9412. )      
  9413. read(fields%,
  9414. ,RA%,$database%)
  9415.       
  9416.  loop%=1 
  9417.  fields%
  9418. )        $Rf%(loop%)=
  9419. #F,len%(loop%))
  9420.       
  9421.       
  9422. write(fields%,key%)
  9423.         
  9424.  "!QUERY":
  9425.  params$<>"" 
  9426.       P%=
  9427. params$,",")
  9428. !      formula$=
  9429. params$,P%+1)
  9430.       name$=
  9431. params$,P%-1)
  9432.       name$=
  9433. name$,10)
  9434. $      Search$=
  9435. parse(formula$,
  9436. $      $
  9437. text(matchW%,0)=formula$
  9438. !      
  9439. redraw_icon(matchW%,0)
  9440.       
  9441.  "Hourglass_On"
  9442.       scripton%=
  9443.       
  9444. do_it(Search$,
  9445. #      
  9446. selected(printW%,38) 
  9447. ?        filename$=$database%+".PrintJobs."+name$:Type%=&FFF
  9448. ;        Start%=!textanchor%:End%=Start%+Count%*LenLine%
  9449.         
  9450. )          
  9451.  ImpCom$="":$Start%=pitch$
  9452. 9          
  9453.  ImpCom$<>"" 
  9454.  firstquery%=
  9455. :firstquery%=
  9456.           
  9457. :$Start%=ImpCom$
  9458.         
  9459. ".        
  9460. save(filename$,Type%,Start%,End%)
  9461.       
  9462. $        
  9463.  "!SELECTION":
  9464.  params$<>"" 
  9465. '3      filename$=$database%+".PrintRes."+params$
  9466. (-      
  9467.  "OS_File",5,filename$ 
  9468.  ,,ftype%
  9469. )#      ftype%=(ftype%>>8) 
  9470.  &FFF
  9471. *4      
  9472.  ftype%=&7F3 
  9473. drag_selection(filename$)
  9474.       
  9475. clear_selection
  9476. ,        
  9477.  "!PRINTOPTS":
  9478.  params$<>"" 
  9479. /3      filename$=$database%+".PrintRes."+params$
  9480. 0-      
  9481.  "OS_File",5,filename$ 
  9482.  ,,ftype%
  9483. 1#      ftype%=(ftype%>>8) 
  9484.  &FFF
  9485. 22      
  9486.  ftype%=&7F5 
  9487. drag_options(filename$)
  9488. 3<      
  9489. drag_options("<Pbase$Dir>.Resources.PrintOpts")
  9490. 4        
  9491. 5.    
  9492.  "!CASE":
  9493. set_icon(matchW%,16,state%)
  9494. 6/    
  9495.  "!INDEX":
  9496. set_icon(matchW%,23,state%)
  9497. 70    
  9498.  "!EXPAND":
  9499. set_icon(printW%,11,state%)
  9500. 8.    
  9501.  "!DATE":
  9502. set_icon(printW%,19,state%)
  9503. 9/    
  9504.  "!UPPER":
  9505. set_icon(printW%,12,state%)
  9506. :/    
  9507.  "!FIRST":
  9508. set_icon(printW%,10,state%)
  9509. ;3    
  9510.  "!UNDERLINE":
  9511. set_icon(printW%,29,state%)
  9512. <0    
  9513.  "!SHRINK":
  9514. set_icon(printW%,40,state%)
  9515. =-    
  9516.  "!TITLE":$
  9517. text(printW%,18)=params$
  9518. >,    
  9519.  "!PAGE":$
  9520. text(printW%,16)=params$
  9521. ?1    
  9522.  "!LINESPACE":$
  9523. text(printW%,17)=params$
  9524. @/    
  9525.  "!LMARGIN":$
  9526. text(printW%,30)=params$
  9527. A/    
  9528.  "!TMARGIN":$
  9529. text(printW%,32)=params$
  9530. B.    
  9531.  "!SPACER":$
  9532. text(printW%,43)=params$
  9533. C0    
  9534.  "!COLWIDTH":$
  9535. text(printW%,45)=params$
  9536.  "!HEADINGS":
  9537. u(params$) 
  9538. F7      
  9539.  "D":
  9540. select(printW%,2):
  9541. deselect(printW%,1)
  9542. G3      
  9543. select(printW%,1):
  9544. deselect(printW%,2)
  9545. H        
  9546.  "!PITCH":
  9547. J3    
  9548. deselect(printW%,
  9549. selected_esg(printW%,2))
  9550. (params$) 
  9551. L       
  9552. select(printW%,4)
  9553. M!      
  9554. select(printW%,7)
  9555. N!      
  9556. select(printW%,8)
  9557.       
  9558. select(printW%,6)
  9559. P        
  9560.  "!FORMAT":
  9561. R3    
  9562. deselect(printW%,
  9563. selected_esg(printW%,3))
  9564. S"    
  9565. icon_bit(22,printW%,15,
  9566. TM    P%=
  9567. params$," "):
  9568.  P%>0 
  9569.  cols$=
  9570. params$,P%+1):params$=
  9571. params$,P%-1)
  9572.  params$ 
  9573. V*      
  9574.  "VERTICAL":
  9575. select(printW%,24)
  9576. W'      
  9577.  "TABLE":
  9578. select(printW%,25)
  9579. X"      $
  9580. text(printW%,15)=cols$
  9581. Y$      
  9582. icon_bit(22,printW%,15,
  9583. Z'      
  9584.  "LABEL":
  9585. select(printW%,26)
  9586.       
  9587. select(printW%,23)
  9588. \        
  9589.  "!DESTINATION":
  9590. ^3    
  9591. deselect(printW%,
  9592. selected_esg(printW%,4))
  9593.  params$ 
  9594. `9      
  9595.  "FILE":
  9596. select(printW%,39):reportdest$="File"
  9597. a?      
  9598.  "PRINTER":
  9599. select(printW%,41):reportdest$="Printer"
  9600. b4      
  9601. select(printW%,38):reportdest$="Window"
  9602. c        
  9603.  "!LABEL":
  9604.     params$+=","
  9605.  I%=1 
  9606.       P%=
  9607. params$,",")
  9608. h4      par$=
  9609. params$,P%-1):params$=
  9610. params$,P%+1)
  9611.       
  9612.         
  9613. k7        
  9614. deselect(labelW%,
  9615. selected_esg(labelW%,1))
  9616.         
  9617.  par$ 
  9618. m&          
  9619.  "1":
  9620. select(labelW%,0)
  9621. n&          
  9622.  "2":
  9623. select(labelW%,1)
  9624. o"          
  9625. select(labelW%,2)
  9626.         
  9627. q&        
  9628. text(labelW%,4)=par$
  9629. r&        
  9630. text(labelW%,6)=par$
  9631. s'        
  9632. text(labelW%,10)=par$
  9633. t'        
  9634. text(labelW%,12)=par$
  9635. u,        
  9636. set_icon(labelW%,11,(par$<>""))
  9637. v:        
  9638. icon_bit(22,labelW%,12,
  9639. selected(labelW%,11))
  9640. w5        
  9641. set_icon(labelW%,13,(
  9642. u(par$)="ON"))
  9643. x5        
  9644. set_icon(labelW%,16,(
  9645. u(par$)="ON"))
  9646.       
  9647.  "!IMPRESSION":
  9648.     P%=
  9649. params$," ")
  9650.  P%>0 
  9651. ~9      ImpCom$=
  9652. params$,P%-1):modifier$=
  9653. params$,P%+1)
  9654.       
  9655. u(modifier$) 
  9656. '        
  9657.  "NOT FIRST":firstquery%=
  9658.       
  9659.       
  9660.  ImpCom$=params$
  9661.         
  9662.         
  9663. softerror("",46)
  9664.     finished%=
  9665.  "Hourglass_Smash"
  9666. close_file(F)
  9667. abort_script
  9668. close_file(F)
  9669. softerror("",57)
  9670. wimp_error(
  9671.  "Impulse" handling -----------------------------------------------
  9672. Impulse_command(token%,params%,object%)
  9673. 4param$=
  9674. getstr(params%):object$=
  9675. getstr(object%)
  9676.  object$="" 
  9677.  object$=
  9678. leaf($database%)
  9679.  token% 
  9680.  ### GetPathname. Returns full pathname of object ###
  9681. leaf($database%) 
  9682.  object$:
  9683. <    
  9684.  "Impulse_SendMessage",&202,$database%,,,,,mytask%
  9685.  "No data":
  9686. D    
  9687.  "Impulse_SendMessage",&202,"No database open",,,,,mytask%
  9688. T    
  9689.  "Impulse_SendMessage",&202,"Current database is not "+object$,,,,,mytask%
  9690.  ### Selection. Returns maximum data length ###
  9691.   ClientSep$=
  9692. param$,1)
  9693. ?  ClientForm$=
  9694. find_fields(param$,ClientSep$,ClientLength%)
  9695. extend_named_sliding_block(transanchor%,ClientLength%+1)
  9696.  "Impulse_SendMessage",&202,
  9697. (ClientLength%),,,,,mytask%
  9698.  ### ParseQuery. Returns title generated by FNparse ###
  9699. $  ClientSearch$=
  9700. parse(param$,
  9701.  "Impulse_SendMessage",&202,Title$,,,,,mytask%
  9702.  ### GetRecord. Returns data specified in Selection according to criteria specified in ParseQuery ###
  9703. <  datalength%=
  9704. prepare_next_record(param$,!transanchor%)
  9705.  "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,Length%
  9706.  ### PutRecord ###
  9707.  "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask%
  9708.  ### ExpandCode ###
  9709.   P%=
  9710. param$," ")
  9711. .  code$=
  9712. param$,P%-1):table$=
  9713. param$,P%+1)
  9714.  "Impulse_SendMessage",&202,
  9715. expand(code$,table$,L%,SF$),,,,,mytask%
  9716.  7,8:
  9717.  ### GetField, GetExpanded ###
  9718.  params%<>-1 
  9719. D    datalength%=
  9720. prepare_next_field(token%,param$,!transanchor%)
  9721. \    
  9722.  "Impulse_SendMessage",&202,"Ready to receive?",-1,,,transtag%,mytask%,datalength%
  9723. 2    
  9724.  Max. length for a Powerbase field is 246
  9725. Impulse_reply(replytag%,reply%)
  9726. abort_merge:
  9727. reply$=
  9728. getstr(reply%)
  9729.  replytag% 
  9730.  getrec%:
  9731.  ### Reply to GetRecord command. ###
  9732.  "Impulse_FetchData",!transanchor%,Length%,,,,,mytask%
  9733.  mergetag%:
  9734.  ### Merging application replies when all data in document merged ###
  9735. selected(mergeW%,6) 
  9736.  "Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Print",,,,printtag%,mytask%
  9737.  printtag%:
  9738.  ### Merging application has printed the current document ###
  9739.  "OS_Byte",229,0
  9740. 2  mergenum%+=1:$
  9741. text(mergeW%,14)=
  9742. (mergenum%)
  9743. redraw_icon(mergeW%,14)
  9744. selected(mergeW%,6) 
  9745.  ClientPtr%<>top 
  9746. ,    ClientPtr%=
  9747. merge_next(ClientPtr%,1)
  9748. deselect(mergeW%,6)
  9749. abort_merge
  9750. close_file(dbasehandle%)
  9751. ClientPtr%=top
  9752. deselect(mergeW%,6)
  9753. perform_close(mergeW%)
  9754. softerror("",27)
  9755. wimp_error(
  9756. Impulse_send(tag%,maxsize%)
  9757.  "Impulse_TransmitData",!transanchor%,datalength%,,,,,mytask%
  9758. datalength%=0
  9759. Impulse_receive(replytag%,expected%,received%)
  9760.  I%,F%,P%
  9761. transbuff%=!transanchor%
  9762. transbuff%?received%=13
  9763. data$=$transbuff%
  9764.  ### Acknowledge data received (get reason code 19 otherwise!) ###
  9765.  "Impulse_SendMessage",&202,,,,,replytag%,mytask%
  9766.  data$<>"" 
  9767.   P%=
  9768. data$,"#")
  9769.   REC%=
  9770. data$,P%-1))
  9771.   data$=
  9772. data$,P%+1)
  9773.  REC%=-1 
  9774.  REC%=RA%
  9775. read(fields%,REC%<>RA%,REC%,$database%)
  9776.  I%=1 
  9777. (ClientForm$) 
  9778. $    F%=
  9779. fnum(
  9780. ClientForm$,I%,2))
  9781. <    
  9782.  data$<>"" 
  9783.  $Rf%(F%)=
  9784. get_string(data$,ClientSep$)
  9785. write(fields%,key%)
  9786.  received%=0 
  9787.  "Impulse_SendMessage",&201,"GetRecord",,,,getrec%,mytask%
  9788. get_string(
  9789.  S$,sep$)
  9790.  P%,F$
  9791. S$,sep$)
  9792.  P%>0 
  9793.   F$=
  9794. S$,P%-1)
  9795.   S$=
  9796. S$,P%+1)
  9797. prepare_next_record(key$,transbuff%)
  9798.  ok%,I%,F%,P%
  9799.  dbasehandle%=0 
  9800. ,  dbasehandle%=
  9801. ($database%+".Database")
  9802. '  ClientPtr%=
  9803. neighbour(key%,top,1)
  9804. P%=transbuff%
  9805.  key$ 
  9806.  "***":
  9807. close_file(dbasehandle%)
  9808.   $P%=key$:P%+=
  9809. ($P%)+1
  9810.  ok%=
  9811.  ClientPtr%<>top
  9812. (    REC%=
  9813. rec_no(k$,key%,ClientPtr%)
  9814. '    
  9815. readsmarray(dbasehandle%,REC%)
  9816. (ClientSearch$)=
  9817. $      $P%=
  9818. (REC%)+"#":P%+=
  9819. ($P%)
  9820. %      
  9821.  I%=1 
  9822. (ClientForm$) 
  9823. (        F%=
  9824. fnum(
  9825. ClientForm$,I%,2))
  9826. ,        $P%=F$(F%)+ClientSep$:P%+=
  9827. ($P%)
  9828.       
  9829.       $P%+=ClientSep$:P%+=1
  9830.       ok%=
  9831.         
  9832. 0    ClientPtr%=
  9833. neighbour(key%,ClientPtr%,1)
  9834.  P%=transbuff% 
  9835. close_file(dbasehandle%)
  9836. #"  val$=
  9837. type(key%):kl%=
  9838. (key$)
  9839. $%  ClientPtr%=
  9840. search(key$,key%,1)
  9841.  ClientPtr%>=0 
  9842. &(    REC%=
  9843. rec_no(k$,key%,ClientPtr%)
  9844. ''    
  9845. readsmarray(dbasehandle%,REC%)
  9846. ("    $P%=
  9847. (REC%)+"#":P%+=
  9848. ($P%)
  9849. )#    
  9850.  I%=1 
  9851. (ClientForm$) 
  9852. *&      F%=
  9853. fnum(
  9854. ClientForm$,I%,2))
  9855. +*      $P%=F$(F%)+ClientSep$:P%+=
  9856. ($P%)
  9857.     $P%+=ClientSep$:P%+=1
  9858. =P%-transbuff%
  9859. prepare_next_field(method%,S$,transbuff%)
  9860.  L%,F%,P%,len%,T$,F$,V%,R%,b$,k$,SF$
  9861.  token% 
  9862. 6&  F%=
  9863. field(S$,
  9864. ):V%=chartype%(F%)
  9865. 8C    
  9866.  0,1,2,3,4,5,6,7,8,46,47,48,49,50,51,52,53,54,55,56,57,58:
  9867.     L%=
  9868. (F$(F%))
  9869. :D    
  9870. extend_named_sliding_block(transanchor%,(L%+4) 
  9871.  &FFFFFFFC)
  9872. ;     transbuff%=!transanchor%
  9873. <*    $transbuff%=F$(F%):transbuff%?L%=0
  9874.  36,39:
  9875. >&    R%=
  9876. rec_no(k$,key%,ClientPtr%)
  9877. ?/    L%=
  9878. blob_path(
  9879. ,$database%,R%,F%,V%,b$)
  9880.  L%>0 
  9881. AF      
  9882. extend_named_sliding_block(transanchor%,(L%+4) 
  9883.  &FFFFFFFC)
  9884. B"      transbuff%=!transanchor%
  9885. C(      
  9886.  "OS_File",255,b$,transbuff%
  9887.       
  9888.  L%=1
  9889. E7      
  9890. extend_named_sliding_block(transanchor%,256)
  9891. F"      transbuff%=!transanchor%
  9892.       ?transbuff%=0
  9893. H        
  9894.     transbuff%?L%=0
  9895. L+  P%=
  9896. S$," "):T$=
  9897. S$,P%+1):S$=
  9898. S$,P%-1)
  9899. M2  F%=
  9900. field(S$,
  9901. ):F$=
  9902. expand(F$(F%),T$,L%,SF$)
  9903. extend_named_sliding_block(transanchor%,L%+1)
  9904.   transbuff%=!transanchor%
  9905. P6  $transbuff%=F$:L%=
  9906. ($transbuff%):transbuff%?L%=0
  9907. len%=(L%+4) 
  9908.  &FFFFFFFC
  9909. S    =len%
  9910. ready_to_merge
  9911. Imp_wait%=
  9912. :merging%=
  9913. text(mergeW%,1)=document$
  9914.  common% 
  9915. text(mergeW%,3)=""
  9916. open_window(mergeW%)
  9917. set_caret(mergeW%,3)
  9918.  "Impulse_SendMessage",&200,":"+mergewith$+"."+document$+" Edit Off",,,,-1,mytask%
  9919. merge_next(P%,D%)
  9920. D%=(D%+1) 
  9921. `'P%=
  9922. next_match(P%,D%,ClientSearch$)
  9923.  P%<>top 
  9924. b,  S$=F$(KF%(key%,0))+" "+F$(KF%(key%,1))
  9925. c   $
  9926. text(mergeW%,13)=
  9927. S$,80)
  9928. redraw_icon(mergeW%,13)
  9929.  "Impulse_SendMessage",&201,":"+mergewith$+"."+document$+" Merge",,,,mergetag%,mytask%
  9930.  End of "Impulse" handling -------------------------------------------
  9931.  Import/Export CSV files ---------------------------------------------
  9932. start_import(type$,wi%)
  9933.  present% 
  9934.  fields%=0 
  9935.  OK%=
  9936. softerror("",69)
  9937.  Modify% 
  9938.  OK%=
  9939. softerror("",14)
  9940. softerror("",69)
  9941.  OK% 
  9942. v   $
  9943. text(csvW%,13)=filename$
  9944. icon_bit(22,csvW%,0,
  9945. x4  !block%=csvW%:
  9946.  "Wimp_GetWindowState",,block%
  9947. y)  block%!4=800:block%!12=block%!4+390
  9948. z)  block%!8=150:block%!16=block%!8+716
  9949. {(  $CSVTitle%="Import "+type$+" file"
  9950.  "Wimp_OpenWindow",,block%
  9951. set_caret(csvW%,13)
  9952. write_csv(Filename$)
  9953.  writingcsv% 
  9954.  printorder$<>"" 
  9955.  Form$=printorder$ 
  9956. softerror("",34):
  9957.  P%,rec%,examined%,subtotal%
  9958. end_csv:
  9959. csvhandle%=
  9960. (Filename$)
  9961. selected(csvW%,1) 
  9962. csv_head
  9963. *dbasehandle%=
  9964. ($database%+".Database")
  9965. >Search$=
  9966. parse($
  9967. text(savesubW%,0),
  9968. selected(savesubW%,5))
  9969.  "Hourglass_On"
  9970. neighbour(key%,top,1)
  9971. scan_file("P%<>top",key%,3)
  9972.  "Hourglass_Off"
  9973. close_file(csvhandle%)
  9974. close_file(dbasehandle%)
  9975.  sep$="," 
  9976.  type%=&dfe 
  9977.  type%=&fff
  9978.  "OS_File",18,Filename$,type%
  9979. writingcsv%=
  9980. end_csv
  9981.  "Hourglass_Smash"
  9982. close_file(csvhandle%)
  9983. close_file(dbasehandle%)
  9984. close_file(F)
  9985.  "OS_File",18,Filename$,&dfe
  9986. writingcsv%=
  9987. softerror("",41)
  9988. wimp_error(
  9989. csv_head
  9990.  I%,F%,f$,H$,Head$,N%
  9991.     I%=-1
  9992. (Form$)-1
  9993. (  I%+=2:F%=
  9994. fnum(
  9995. Form$,I%,2)):N%+=1
  9996. selected(printW%,2) 
  9997.  Head$=$
  9998. text(mainW%,(desc%(F%))) 
  9999.  Head$=Tag$(F%)
  10000. selected(csvW%,4) 
  10001.  Head$=
  10002. (len%(F%))+"
  10003. "+Head$+"
  10004. (chartype%(F%))
  10005.  chartype%(F%)<>3 
  10006.  chartype%(F%)<>6 
  10007. selected(csvW%,0) 
  10008.  Head$=""""+Head$+""""
  10009.  N%>1 
  10010.  Head$=sep$+Head$
  10011. #csvhandle%,Head$;
  10012. #csvhandle%,term$;
  10013. write_csv_rec(R%)
  10014.  I%,F%,f$,F$,L%,N%,filename$,len%,base%,SF$
  10015. selected(csvW%,3) 
  10016.   F$=
  10017. key2(0,1)
  10018. selected(csvW%,0) 
  10019.  F$=""""+F$+""""
  10020. #csvhandle%,F$+sep$;
  10021. I%=-1:L%=
  10022. (Form$)-1
  10023.  I%<L%
  10024. "  I%+=2:F%=
  10025. fnum(
  10026. Form$,I%,2))
  10027.  chartype%(F%) 
  10028.  36,39:
  10029. ,    len%=
  10030. load_blob($database%,R%,F%,36)
  10031. '    
  10032.  len%>0 
  10033. selected(csvW%,2) 
  10034. +      N%+=1:
  10035.  N%>1 
  10036. #csvhandle%,sep$;
  10037. 3      
  10038. selected(csvW%,0) 
  10039. #csvhandle%,"""";
  10040. (      
  10041. blob_to_file(csvhandle%,len%)
  10042. 3      
  10043. selected(csvW%,0) 
  10044. #csvhandle%,"""";
  10045.         
  10046.  3,6,46,47,54,56,57:
  10047.     F$=F$(F%):N%+=1
  10048. '    
  10049.  F$<>"" 
  10050. selected(csvW%,2) 
  10051.       
  10052.  N%>1 
  10053.  F$=sep$+F$
  10054.       
  10055. #csvhandle%,F$;
  10056.         
  10057. !    
  10058. selected(printW%,11) 
  10059. /      F$=
  10060. expand(F$(F%),link$(F%),Len%,SF$)
  10061.       
  10062.  F$=F$(F%)
  10063.         
  10064.     N%+=1
  10065. '    
  10066.  F$<>"" 
  10067. selected(csvW%,2) 
  10068. 0      
  10069. selected(csvW%,0) 
  10070.  F$=""""+F$+""""
  10071.       
  10072.  N%>1 
  10073.  F$=sep$+F$
  10074.       
  10075. #csvhandle%,F$;
  10076.         
  10077. #csvhandle%,term$;
  10078. convert_csv(f$)
  10079.  k$,B%,J%,fld%,csvhandle%,toobighandle%,S$,sep%,sep2%,term%,term2%,F$,A%,F%,keybase%,base%,base2%,show%,done%
  10080. stop_reading:
  10081. size%=&100:inc%=size%
  10082. extend_named_sliding_block(tempanchor%,size%)
  10083. :sep%=
  10084. (sep$):
  10085. (sep$)=2 
  10086.  sep2%=
  10087. sep$)) 
  10088.  sep2%=255
  10089. @term%=
  10090. (term$):
  10091. (term$)=2 
  10092.  term2%=
  10093. term$)) 
  10094.  term2%=255
  10095. csvhandle%=
  10096.  present%=0 
  10097. csv_to_dbase(f$)
  10098. Form$=
  10099. csv_importform
  10100. 3toobighandle%=
  10101. ($database%+".PrintJobs.TooBig")
  10102.  "Hourglass_On"
  10103. selected(csvW%,3):
  10104. read_bytes
  10105. ,    addr=
  10106. find(
  10107. $base%,KL%(key%)),0,1,
  10108. "    REC%=
  10109. rec_no(k$,key%,addr)
  10110. (    
  10111. read(fields%,
  10112. ,REC%,$database%)
  10113. 2    keybase%=!keyanchor%(0):A%=!keybase%:F%=A%
  10114.  !(keybase%+F%)>0 
  10115. :      A%=!(keybase%+F%):REC%=!(keybase%+F%+8+KL%(0)+1)
  10116.       
  10117.       incr%=
  10118. ($Increment%)
  10119.       
  10120.  incr%>0 
  10121. '        
  10122. change_length(RA%+incr%,
  10123. 6        keybase%=!keyanchor%(0):A%=!keybase%:F%=A%
  10124. <        A%=!(keybase%+F%):REC%=!(keybase%+F%+8+KL%(0)+1)
  10125. "        
  10126.  moan_err%,
  10127. msg(66)
  10128.       
  10129.         
  10130. '    
  10131. read(fields%,
  10132. ,RA%,$database%)
  10133.   endline%=
  10134. :J%=-1
  10135. (Form$)-2 
  10136.  endline%=
  10137. &    J%+=2:fld%=
  10138. fnum(
  10139. Form$,J%,2))
  10140. !    
  10141. transfer_csv_field(fld%)
  10142.  fld%<fields% 
  10143.  endline% 
  10144. next_csv_rec
  10145. write(fields%,key%)
  10146. selected(csvW%,11) 
  10147. redraw(mainW%)
  10148.  "Hourglass_Percentage",
  10149. #csvhandle%*100 
  10150. #csvhandle%
  10151.  "OS_Byte",229,0
  10152. #csvhandle%
  10153.  "Hourglass_Off"
  10154. close_file(csvhandle%)
  10155. close_file(toobighandle%)
  10156. scrap_sliding_block(tempanchor%)
  10157.  "OS_File",18,$database%+".PrintJobs.TooBig",&fff
  10158. addr=
  10159. moveto(key%,top,1)
  10160. clear_selection
  10161. close_window(csvW%)
  10162. selected(passW%,16) 
  10163. #loghandle%,"CSV data imported from "+f$
  10164. transfer_csv_field(
  10165.  fld%)
  10166.  chartype%(fld%) 
  10167.  36,39:
  10168. read_bytes
  10169. 1  Z%=
  10170. blob_path(
  10171. ,$database%,REC%,fld%,36,F$)
  10172. "  Start%=base%:End%=base%+ptr%
  10173. save(F$,&fff,Start%,End%)
  10174. selected(csvW%,11) 
  10175.  chartype%(fld%)=39 
  10176. show_text_block(fld%)
  10177.  0,1,2,3,4,5,6,7,8,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57:
  10178. read_bytes
  10179. selected(csvW%,16) 
  10180.  $base%=
  10181. stripspaces($base%)
  10182.  ,    
  10183.  ptr%<=len%(fld%):$Rf%(fld%)=$base%
  10184.  ptr%<247:
  10185. "A    
  10186. #toobighandle%,"Rec."+
  10187. (REC%)+",Fld."+
  10188. (fld%)+","+$base%
  10189.     $Rf%(fld%)="@"
  10190. #toobighandle%,"Rec."+
  10191. (REC%+1)+",Fld."+
  10192. (fld%)+" is more than 246 characters long. Data not saved. External field suggested."
  10193.     $Rf%(fld%)="@"
  10194. :fld%+=1
  10195.  ### Can't put CSV data into Button, Sprite or Draw fields! ###
  10196. read_bytes
  10197.  end$,flag%,B%,nq%
  10198. base%=!tempanchor%:ptr%=-1
  10199. #csvhandle%
  10200.  B%=34 
  10201.   flag%=
  10202. :nq%=1
  10203. 3c  end$="(base%?(ptr%-1)=34 AND (nq% MOD 2)=0) AND (B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE)"
  10204. #csvhandle%=
  10205. #csvhandle%-1
  10206. 67  end$="B%=sep% OR B%=term% OR EOF#csvhandle%=TRUE"
  10207. 9+  B%=
  10208. #csvhandle%:ptr%+=1:base%?ptr%=B%
  10209.  B%=34 
  10210.  nq%+=1
  10211.  ptr%=size% 
  10212.  size%+=inc%:
  10213. extend_named_sliding_block(tempanchor%,size%)
  10214. (end$)
  10215.  flag% 
  10216.  ptr%-=1
  10217. base%?ptr%=13
  10218.  sep%:
  10219. skip_sep
  10220.  term%:
  10221. skip_term
  10222. next_csv_rec
  10223.   B%=
  10224. #csvhandle%
  10225.  B%=term%
  10226. skip_term
  10227. skip_sep
  10228.  sep2%<>255 
  10229.   B%=
  10230. #csvhandle%
  10231.  B%<>sep2% 
  10232. #csvhandle%=
  10233. #csvhandle%-1
  10234. skip_term
  10235.  term2%<>255 
  10236.   B%=
  10237. #csvhandle%
  10238.  B%<>term2% 
  10239. #csvhandle%=
  10240. #csvhandle%-1 
  10241.  endline%=
  10242.  endline%=
  10243. stop_reading
  10244.  "Hourglass_Off"
  10245. close_file(csvhandle%):
  10246. close_file(toobighandle%)
  10247. scrap_sliding_block(tempanchor%)
  10248.  =17 
  10249. softerror("",74)
  10250. wimp_error(
  10251.  present%=7 
  10252.   addr=
  10253. moveto(key%,top,1)
  10254. clear_selection
  10255. csv_importform
  10256.  F%,f$,F$
  10257. endline%=
  10258. selected(csvW%,1):
  10259.  ### Use header record to build form ###
  10260. read_bytes
  10261.     F%=
  10262. field($base%,
  10263. r%    
  10264.  F%=0 
  10265.  moan_err%,
  10266. msg(87)
  10267.     f$=
  10268. ~(F%)
  10269. (f$)=1 
  10270.  f$="0"+f$
  10271.     F$+=f$
  10272. v"    
  10273. invert(mainW%,field%(F%))
  10274.  endline%
  10275.  printorder$<>"":
  10276.  ### Build form from highlighted fields, as in printing ###
  10277.   F$=printorder$
  10278.  ### Assume entry into all fields, beginning with first ###
  10279.  F%=1 
  10280.  fields%
  10281.     f$=
  10282. ~(F%)
  10283. (f$)=1 
  10284.  f$="0"+f$
  10285.     F$+=f$
  10286. csv_to_dbase(f$)
  10287.  F%,P%,Q%,FH%,S$,readpos%
  10288. selected(csvW%,4) 
  10289. selected(csvW%,1)) 
  10290.  moan_err%,
  10291. msg(88)
  10292. read_bytes:S$=$base%:
  10293. #csvhandle%=0
  10294. ")=0 
  10295.  moan_err%,
  10296. msg(89)
  10297. leaf$=
  10298. leaf(f$):csvconv%=
  10299.  $database%="No data" 
  10300.  $database%=dbasepath$+".!"+leaf$
  10301. save($database%,0,0,0)
  10302. fields%=0:endline%=
  10303.   fields%+=1
  10304. read_bytes:S$=$base%
  10305. "  P%=
  10306. "):Q%=
  10307. ",P%+1)
  10308. %  Tag$(fields%)=
  10309. S$,P%+1,Q%-P%-1)
  10310.    len%(fields%)=
  10311. S$,P%-1))
  10312. %  chartype%(fields%)=
  10313. S$,Q%+1))
  10314.  endline%
  10315. scrap_sliding_block(tempanchor%)
  10316. ($database%+".Form")
  10317. #FH%,fields%
  10318.  F%=1 
  10319.  fields%
  10320.   xd%=16:xf%=96
  10321.   yd%=-(F%*52):yf%=yd%
  10322. #FH%,Tag$(F%),Tag$(F%),xd%,yd%,xf%,yf%,len%(F%),chartype%(F%),0,0
  10323. close_file(FH%)
  10324.  "OS_File",18,$database%+".Form",&7f2
  10325. fields%=0:Fieldnumber%=0
  10326. fields%=
  10327. get_form(Fptr%)
  10328. default_key
  10329. readpos%=
  10330. #csvhandle%
  10331. no_of_recs
  10332. defaults($database%,RA%,0)
  10333. save_keys
  10334. deselect(csvW%,1)
  10335. create_named_sliding_block(tempanchor%,size%)
  10336. csvhandle%=
  10337. #csvhandle%=readpos%
  10338. no_of_recs
  10339.  N%,B%
  10340. #csvhandle%
  10341.  B%=term% 
  10342. #csvhandle%
  10343.   N%+=1
  10344.  "Hourglass_Percentage",
  10345. #csvhandle%*100 
  10346. #csvhandle%
  10347. #csvhandle%
  10348.  --- SLIDING HEAP 2.00 PROCEDURES
  10349.  requires SlidingHeap 2.00
  10350.  module and PROCs
  10351.  Steven Haslam 1992
  10352. _heap_slotsize
  10353.  "Wimp_SlotSize",-1,-1 
  10354. _heap_numtostr(d%,n%)=
  10355. d%,"0")+
  10356. ~n%,d%)
  10357. _heap_snumtostr(d%,n%)=
  10358. d%," ")+
  10359. n%,d%)
  10360. heapsinfo
  10361.  "OS_Heap",1,fixedheapbase% 
  10362.  ,,bigbloc%,totfree%
  10363.  "Fixed heap"
  10364.  "----- ----"
  10365.  "Heap base    : &";
  10366. _heap_numtostr(8,fixedheapbase%)
  10367.  "Heap size    : ";
  10368. _heap_bytes2(fixedheapsize%)
  10369.  "Largest free : ";
  10370. _heap_bytes2(bigbloc%)
  10371.  "Total free   : ";
  10372. _heap_bytes2(totfree%)
  10373.  "Sliding heap"
  10374.  "------- ----"
  10375.  "SlidingHeap_HeapInfo",slidingheapbase%
  10376. _heap_pageup(n%)
  10377.  "OS_ReadMemMapInfo" 
  10378. =(n%+R0%-1) 
  10379.  (R0%-1)
  10380. initheaps(heapsize%,slidingblocks%)
  10381. fixedheapsize%=heapsize%
  10382. Lheap_trigger%=
  10383. _heap_pageup(
  10384. +fixedheapsize%+20+20*slidingblocks%-&8000)
  10385. setslotsize(heap_trigger%)
  10386. _heap_slotsize<heap_trigger% 
  10387.  130,"Unable to initialise heap"
  10388. fixedheapbase%=
  10389. %slidingheapbase%=
  10390. +fixedheapsize%
  10391.  "OS_Heap",0,fixedheapbase%,,fixedheapsize%
  10392.  "SlidingHeap_Create",slidingheapbase%,2,slidingblocks%
  10393.  "SlidingHeap_VerifyHeap",slidingheapbase%
  10394. _heap_nextfree
  10395.  nextfree%
  10396.  "SlidingHeap_NextFree",slidingheapbase% 
  10397.  nextfree%
  10398. =nextfree%
  10399. destroyheaps
  10400. setslotsize(
  10401. -&8000)
  10402. _heap_wordup(x%)=(x%+3) 
  10403. create_anchor(name$)
  10404.  space%
  10405.  space% 4+
  10406. name$+1
  10407. !space%=0
  10408. $(space%+4)=name$
  10409. =space%
  10410. create_named_sliding_block(anchor%,size%)
  10411.  trysize%
  10412. size%=
  10413. _heap_wordup(size%)
  10414. 7trysize%=
  10415. _heap_pageup(
  10416. _heap_nextfree+size%-&7FF4)
  10417.  trysize%>heap_trigger% 
  10418. setslotsize(trysize%)
  10419. _heap_slotsize<trysize% 
  10420. %      
  10421. setslotsize(heap_trigger%)
  10422. F      
  10423.  131,"Not enough room to create block """+$(anchor%+4)+""""
  10424.        heap_trigger%=trysize%
  10425.  "SlidingHeap_NewBlock",slidingheapbase%,anchor%,size%,anchor%+4
  10426.  "SlidingHeap_VerifyHeap",slidingheapbase%
  10427. scrap_sliding_block(anchor%)
  10428.  !anchor%=0 
  10429.  "SlidingHeap_ScrapBlock",slidingheapbase%,anchor%
  10430. 1trysize%=
  10431. _heap_pageup(
  10432. _heap_nextfree-&7FFC)
  10433.  trysize%<>heap_trigger% 
  10434. setslotsize(trysize%)
  10435.    heap_trigger%=trysize%
  10436. !anchor%=0
  10437.  "SlidingHeap_VerifyHeap",slidingheapbase%
  10438. setslotsize(newsize%)
  10439.  "Wimp_SlotSize",newsize%,-1
  10440. extend_named_sliding_block(anchor%,newsize%)
  10441.  !anchor%=0 
  10442. create_named_sliding_block(anchor%,newsize%):
  10443.  !anchor%>
  10444. _heap_nextfree 
  10445.  129,"Block beyond heap limits"
  10446. $newsize%=
  10447. _heap_wordup(newsize%)
  10448.  "SlidingHeap_DescribeBlock",slidingheapbase%,anchor% 
  10449.  ,,oldsize%
  10450. larger%=newsize%>oldsize%
  10451.  larger% 
  10452. H   trysize%=
  10453. _heap_pageup(
  10454. _heap_nextfree+(newsize%-oldsize%)-&7FFC)
  10455.   !   
  10456.  trysize%>heap_trigger% 
  10457.  !       
  10458. setslotsize(trysize%)
  10459.  "&      
  10460. _heap_slotsize<trysize% 
  10461.  #(         
  10462. setslotsize(heap_trigger%)
  10463.  $@         
  10464.  132,"Not enough room to extend block #"+
  10465. ~anchor%
  10466.       
  10467.  &#         heap_trigger%=trysize%
  10468.       
  10469.  "SlidingHeap_ExtendBlock",slidingheapbase%,anchor%,newsize%
  10470.  +1trysize%=
  10471. _heap_pageup(
  10472. _heap_nextfree-&7FFC)
  10473.  trysize%<>heap_trigger% 
  10474. setslotsize(trysize%)
  10475.    heap_trigger%=trysize%
  10476.  "SlidingHeap_VerifyHeap",slidingheapbase%
  10477. _heap_bytes(b%)
  10478.  end%
  10479.  "OS_ConvertFixedFileSize",b%,block%,block%+&100 
  10480.  ,end%
  10481. ?end%=13
  10482. =$block%
  10483. _heap_bytes2(b%)
  10484.  end%
  10485.  "OS_ConvertFileSize",b%,block%,block%+&100 
  10486.  ,end%
  10487. ?end%=13
  10488. =$block%
  10489. create_fixed_block(size%)
  10490.  pointer%,flag%
  10491.  "XOS_Heap",2,fixedheapbase%,,size% 
  10492.  ,,pointer%;flag%
  10493.  flag% 
  10494. extendfixedheap
  10495.  "XOS_Heap",2,fixedheapbase%,,size% 
  10496.  ,,pointer%;flag%
  10497. =pointer%
  10498. extendfixedheap
  10499.  nshb%,extend%,trysize%
  10500.  "OS_ReadMemMapInfo" 
  10501.  extend%
  10502.  K$trysize%=
  10503. _heap_slotsize+extend%
  10504. setslotsize(trysize%)
  10505. _heap_slotsize<trysize% 
  10506.  255,"No room to extend fixed heap"
  10507.  N"nshb%=slidingheapbase%+extend%
  10508.  "SlidingHeap_ShiftHeap",slidingheapbase%,nshb%
  10509.  "OS_Heap",5,fixedheapbase%,,extend%
  10510. fixedheapsize%+=extend%
  10511. slidingheapbase%=nshb%
  10512.  "SlidingHeap_VerifyHeap",slidingheapbase%
  10513.